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

Вот пример:

program noname;
TypePData = ^TData;TData = Recordnext: PData;Name: String[ 40 ];{ ...другие поля данных }End;
Varroot: PData; { это указатель на первую запись в связанном списке }
Procedure InsertRecord( Var root: PData; pItem: PData );(* вставляем запись, на которую указывает pItem в список начиная с root и с требуемым порядком сортировки *)VarpWalk, pLast: PData;BeginIf root = Nil Then Begin(* новый список все еще пуст, просто делаем запись, чтобы добавить root к новому списку *)root := pItem;root^.next := NilEnd { If }Else Begin(* проходимся по списку и сравниваем каждую запись с одной включаемой. Нам необходимо помнить последнюю запись, которую мы проверили, причина этого станет ясна немного позже. *)pWalk := root;pLast := Nil;
(* условие в следующем цикле While определяет порядок сортировки! Это идеальное место для передачи вызова функции сравнения, которой вы передаете дополнительный параметр InsertRecord для осуществления общей сортировки, например:While CompareItems( pWalk, pItem ) < 0 Do BeginwhereProcedure InsertRecord( Var list: PData; CompareItems: TCompareItems );andType TCompareItems = Function( p1,p2:PData ): Integer;and a sample compare function:Function CompareName( p1,p2:PData ): Integer;BeginIf p1^.Name < p2^.Name ThenCompareName := -1ElseIf p1^.Name > p2^.Name ThenCompareName := 1ElseCompareName := 0;End;*)While pWalk^.Name < pItem^.Name DoIf 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.

- Peter Below [000809]

Содержание раздела