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 CompareItems( pWalk, 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
