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

Previous  Top  Next

    
 

 

 

Code:

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 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

 

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.

 

 

 

©Drkb::04151

       

Взято с http://delphiworld.narod.ru