Сортировка связанного списка
Материал из DRKB
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