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

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
Category:Алгоритмы
Category:Сортировка