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

Written on . Posted in [Delphi] Алгоритмы

program noname;

Type
PData = ^TData;
TData = Record
next: PData;
Name: String[ 40 ];
{ ...другие поля данных }
End;

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

Procedure InsertRecord( Var root: PData; pItem: PData );
(* вставляем запись, на которую указывает pItem в список начиная с root и с требуемым порядком сортировки *)
Var
pWalk, pLast: PData;
Begin
If root = Nil Then Begin
(* новый список все еще пуст, просто делаем запись, чтобы добавить root к новому списку *)
root := pItem;
root^.next := Nil
End { If }
Else Begin
(* проходимся по списку и сравниваем каждую запись с одной включаемой. Нам необходимо помнить последнюю запись, которую мы проверили, причина этого станет ясна немного позже. *)
pWalk := root;
pLast := Nil;

(* условие в следующем цикле While определяет порядок сортировки! Это идеальное место для передачи вызова функции сравнения, которой вы передаете дополнительный параметр InsertRecord для осуществления общей сортировки, например:
While CompareI pItem ) < 0 Do Begin
where
Procedure InsertRecord( Var list: PData; CompareItems: TCompareItems );
and
Type TCompareItems = Function( p1,p2:PData ): Integer;
and a sample compare function:
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
If pWalk^.next = Nil Then Begin
(* мы обнаружили конец списка, поэтому добавляем новую запись и выходим из процедуры *)
pWalk^.next := pItem;
pItem^.next := Nil;
Exit;
End { If }
Else Begin
(* следующая запись, пожалуйста, но помните, что одну мы только что проверили! *)
pLast := pWalk;

(* если мы заканчиваем в этом месте, то значит мы нашли в списке запись, которая >= одной включенной. Поэтому вставьте ее перед записью, на которую в настоящий момент указывает pWalk, которая расположена после pLast. *)
If pLast = Nil Then Begin
(* Упс, мы вывалились из цикла While на самой первой итерации! Новая запись должна располагаться в верхней части списка, поэтому она становится новым корнем (root)! *)
pItem^.next := root;
root := pItem;
End { If }
Else Begin
(* вставляем pItem между pLast и pWalk *)
pItem^.next := pWalk;
pLast^.next := pItem;
End; { Else }
(* мы сделали это! *)
End; { Else }
End; { InsertRecord }

Procedure SortbyName( Var list: PData );
Var
newtree, temp, stump: PData;
Begin { SortByName }
(* немедленно выходим, если сортировать нечего *)
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; { While }

(* теперь помещаем начало нового, сортированного дерева в начало старого списка *)
list := newtree;
End; { SortByName }
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.

delphi форум