Сортировка связанного списка

Материал из DRKB


program noname;

type
  PData = ^TData;
  TData = record
    Next: PData;
    Name: string[40];
    { ... другие поля данных }
  end;

var
  root: PData; { это указатель на первую запись в связанном списке }

{ вставляем запись, на которую указывает pItem в список начиная
  с root и с требуемым порядком сортировки }
procedure InsertRecord(var root: PData; pItem: PData);
var
  pWalk, pLast: PData;
begin
  if root = nil then
  begin
    { новый список все еще пуст, просто делаем запись, чтобы добавить root к новому списку }
    root := pItem;
    root^.next := nil
  end
  else
  begin
    { проходимся по списку и сравниваем каждую запись с одной
      включаемой. Нам необходимо помнить последнюю запись,
      которую мы проверили, причина этого станет ясна немного позже. }
    pWalk := root;
    pLast := nil;

    { условие в следующем цикле While определяет порядок сортировки!
      Это идеальное место для передачи вызова функции сравнения,
      которой вы передаете дополнительный параметр InsertRecord для
      осуществления общей сортировки, например:

    type
      TCompareItems = function(p1, p2: PData): Integer;

    function CompareName(p1, p2: PData): Integer;
    begin
      if p1^.Name < p2^.Name then
        CompareName := -1
      else
      if p1^.Name > p2^.Name Then
        CompareName := 1
      else
        CompareName := 0;
    end;
    }

    while pWalk^.Name < pItem^.Name do
    begin
      if pWalk^.Next = nil then
      begin
        { мы обнаружили конец списка, поэтому добавляем новую запись и выходим из процедуры }
        pWalk^.Next := pItem;
        pItem^.Next := nil;
        Exit;
      end
      else
      begin
        { следующая запись, пожалуйста, но помните, что одну мы только что проверили! }
        pLast := pWalk;

        { если мы заканчиваем в этом месте, то значит мы нашли
          в списке запись, которая >= одной включенной. Поэтому
          вставьте ее перед записью, на которую в настоящий момент
          указывает pWalk, которая расположена после pLast. }
        if pLast = nil then
        begin
          { Упс, мы вывалились из цикла while на самой первой итерации!
            Новая запись должна располагаться в верхней части списка,
            поэтому она становится новым корнем (root)! }
          pItem^.Next := root;
          root := pItem;
        end
        else
        begin
          { вставляем pItem между pLast и pWalk }
          pItem^.Next := pWalk;
          pLast^.Next := pItem;
        end;
        { мы сделали это! }
      end;
    end;
  end;
end;

procedure SortbyName(var list: PData);
var
  newtree, temp, stump: PData;
begin
  { немедленно выходим, если сортировать нечего }
  if list = nil then
    Exit;
  { в newtree := Nil;}

  { ********
  Сортируем, просто беря записи из оригинального списка и вставляя их
  в новый, по пути "перехватывая" для определения правильной позиции в
  новом дереве. Stump используется для компенсации различий списков.
  temp используется для указания на запись, перемещаемую из одного
  списка в другой.
  ******** }
  stump := list;
  while stump <> nil do
  begin
    { временная ссылка на перемещаемую запись }
    temp := stump;
    { "отключаем" ее от списка }
    stump := stump^.Next;
    { вставляем ее в новый список }
    InsertRecord(newtree, temp);
  end;

  { теперь помещаем начало нового, сортированного дерева в начало старого списка }
  list := newtree;
end;

begin
  New(root);
  root^.Name := 'BETA';
  New(root^.Next);
  root^.Next^.Name := 'ALPHA';
  New(root^.Next^.Next);
  root^.Next^.Next^.Name := 'Torture';

  WriteLn(root^.Name);
  WriteLn(root^.Next^.Name);
  WriteLn(root^.Next^.Next^.Name);
end.


Source: http://delphiworld.narod.ru
ID: 04151