Добавил:
Studfiles2
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:Курсовой проект групп 3341 и 3382 / DMCore / utils / uAlgorithm
.pas
// Функции линейного и бинарного поиска, сортировки, //
// слияния, переупорядочивания элементов списка и //
// другие функции для работы со списком элементов, //
// представленным в виде массива указателей. //
// //
// mailto: acedutils@yandex.ru //
// //
///////////////////////////////////////////////////////////
unit uAlgorithm;
interface
uses Registry, uBinary, uConsts;
{ Прототип функции, используемой для сопоставления значения элементу списка.
Функция должна сравнить значение, ссылка на которое передается параметром
Value, с соответствующим значением, полученным для элемента Item списка.
Если Value меньше, чем значение, рассчитанное для элемента Item, функция
должна вернуть отрицательное число. Если Value больше, чем значение,
рассчитанное для элемента Item, функция возвращает положительное число.
Если Value равно значению, рассчитанному для элемента Item, функция должна
вернуть ноль. }
type
TMatchFunction = function (Value, Item: Pointer): Integer;
{ Прототип функции, используемой при сортировке и группировании элементов
списка. Функция должна сравнить элементы Item1 и Item2 и вернуть значение
меньше нуля, если первый элемент меньше второго, значение больше нуля,
если первый элемент больше второго, и ноль, если элементы равны. }
TCompareFunction = function (Item1, Item2: Pointer): Integer;
{ Функции для поиска, замены, подсчета и удаления элементов массива указателей }
{ G_Search выполняет линейный поиск значения Value в массиве указателей
ItemList, состоящем из Count элементов. Функция для сопоставления значения
элементу массива передается параметром MatchFunction. Функция G_Search
возвращает индекс найденного элемента или -1, если значение не найдено. }
function G_Search(Value: Pointer; ItemList: PPointerItemList; Count: Integer;
MatchFunction: TMatchFunction): Integer;
{ Функции для сортировки массива указателей }
{ G_Sort сортирует по возрастанию массив указателей ItemList, состоящий из
Count элементов. Функция для сравнения двух элементов массива передается
параметром CompareFunction. Используется метод интроспективной сортировки. }
procedure G_Sort(ItemList: PPointerItemList; Count: Integer;
CompareFunction: TCompareFunction);
{ G_StableSort сортирует по возрастанию массив указателей ItemList, состоящий
из Count элементов. Функция для сравнения двух элементов массива передается
параметром CompareFunction. В отличие от процедуры G_Sort, относительное
расположение равных элементов массива не меняется. В ходе выполнения этой
процедуры выделяется дополнительная память. Применяется метод сортировки
слиянием. }
procedure G_StableSort(ItemList: PPointerItemList; Count: Integer;
CompareFunction: TCompareFunction);
{ Функции для бинарного поиска в отсортированном массиве указателей }
{ Следующая функция G_BinarySearch выполняет бинарный поиск значения Value
в массиве указателей ItemList, состоящем из Count элементов. Функция
возвращает индекс элемента массива, значение которого равно Value. Если
в массиве нет элемента с таким значением, функция возвращает -1. Массив
должен быть отсортирован по возрастанию. Функция для сопоставления
значения элементу массива передается параметром MatchFunction. }
function G_BinarySearch(Value: Pointer; ItemList: PPointerItemList; Count: Integer;
MatchFunction: TMatchFunction): Integer; overload;
{ Следующая функция G_BinarySearch выполняет бинарный поиск значения Value
в массиве указателей ItemList, состоящем из Count элементов. Если в ходе
выполнения функции найден элемент массива, значение которого равно Value,
функция возвращает True и индекс найденного элемента в параметре Index.
Если в массиве нет элемента с таким значением, функция возвращает False,
а в параметре Index возвращает индекс элемента, в позицию которого может
быть вставлено искомое значение без нарушения порядка сортировки. Массив
должен быть отсортирован по возрастанию. Функция для сопоставления значения
элементу массива передается параметром MatchFunction. }
function G_BinarySearch(Value: Pointer; ItemList: PPointerItemList; Count: Integer;
MatchFunction: TMatchFunction; out Index: Integer): Boolean; overload;
{ Функции для работы с кучей }
{ Кучей называется бинарное дерево, реализованное в виде последовательного
набора элементов, который обладает двумя важными свойствами: первый элемент
всегда является максимальным, добавление и удаление элементов производится
с логарифмической сложностью. Значение каждого узла такого бинарного дерева
больше или равно значению каждого из его дочерних узлов. }
{ G_MakeHeap переупорядочивает массив указателей ItemList, состоящий из
Count элементов, таким образом, чтобы набор элементов представлял собой
кучу, т.е. значение каждого элемента было больше или равно значению каждого
из его дочерних элементов. Функция для сравнения двух элементов массива
передается параметром CompareFunction. }
procedure G_MakeHeap(ItemList: PPointerItemList; Count: Integer;
CompareFunction: TCompareFunction);
{ G_SortHeap сортирует элементы кучи по возрастанию. Адрес кучи передается
параметром ItemList, число элементов в куче - параметром Count. Функция для
сравнения двух элементов передается параметром CompareFunction. Процедура
G_SortHeap, фактически, реализует метод пирамидальной сортировки. }
procedure G_SortHeap(ItemList: PPointerItemList; Count: Integer;
CompareFunction: TCompareFunction);
implementation
uses Windows, uStrings;
{ Функции для поиска, замены, подсчета и удаления элементов массива указателей }
function G_Search(Value: Pointer; ItemList: PPointerItemList; Count: Integer;
MatchFunction: TMatchFunction): Integer;
var
I: Integer;
begin
Result := -1;
I := 0;
while I < Count do
begin
if MatchFunction(Value, ItemList^[I]) = 0 then
begin
Result := I;
Exit;
end;
Inc(I);
end;
end;
{ Функции для переупорядочивания массива указателей }
procedure IntSort3(ItemList: PPointerItemList; CompareFunction: TCompareFunction);
asm
PUSH EBX
PUSH ESI
PUSH EDI
PUSH EBP
MOV EBX,EAX
MOV EDI,[EBX+4]
MOV ESI,EDX
MOV EBP,[EBX+8]
MOV EDX,EDI
MOV EAX,[EBX]
CALL ESI
TEST EAX,EAX
JNLE @@m2
MOV EAX,EDI
MOV EDX,EBP
CALL ESI
TEST EAX,EAX
JLE @@qt
MOV EAX,[EBX]
MOV EDX,EBP
CALL ESI
TEST EAX,EAX
JNLE @@m1
MOV [EBX+4],EBP
MOV [EBX+8],EDI
JMP @@qt
@@m1: MOV [EBX+8],EDI
MOV EAX,[EBX]
MOV [EBX],EBP
MOV [EBX+4],EAX
JMP @@qt
@@m2: MOV EAX,[EBX]
MOV EDX,EBP
CALL ESI
TEST EAX,EAX
JNLE @@m3
MOV EAX,[EBX]
MOV [EBX],EDI
MOV [EBX+4],EAX
JMP @@qt
@@m3: MOV EAX,EDI
MOV EDX,EBP
CALL ESI
MOV ECX,[EBX]
MOV [EBX+8],ECX
TEST EAX,EAX
JNLE @@m4
MOV [EBX],EDI
MOV [EBX+4],EBP
JMP @@qt
@@m4: MOV [EBX],EBP
@@qt: POP EBP
POP EDI
POP ESI
POP EBX
end;
procedure IntSort4(ItemList: PPointerItemList; CompareFunction: TCompareFunction);
asm
PUSH EBX
PUSH ESI
PUSH EDI
MOV EBX,EAX
MOV EAX,[EAX]
MOV ESI,EDX
MOV EDX,[EBX+4]
CALL ESI
TEST EAX,EAX
JLE @@nx1
MOV EAX,[EBX]
MOV EDX,[EBX+4]
MOV [EBX],EDX
MOV [EBX+4],EAX
@@nx1: MOV EAX,[EBX+8]
MOV EDX,[EBX+12]
CALL ESI
TEST EAX,EAX
JLE @@nx2
MOV EAX,[EBX+8]
MOV EDX,[EBX+12]
MOV [EBX+8],EDX
MOV [EBX+12],EAX
@@nx2: MOV EAX,[EBX]
MOV EDX,[EBX+8]
CALL ESI
MOV EDX,[EBX+12]
MOV EDI,EAX
MOV EAX,[EBX+4]
CALL ESI
TEST EAX,EAX
JNLE @@m2
TEST EDI,EDI
JNLE @@m1
MOV EAX,[EBX+4]
MOV EDX,[EBX+8]
CALL ESI
TEST EAX,EAX
JLE @@qt
MOV EAX,[EBX+4]
MOV EDX,[EBX+8]
MOV [EBX+4],EDX
MOV [EBX+8],EAX
JMP @@qt
@@m1: MOV EAX,[EBX]
MOV EDX,[EBX+8]
MOV [EBX],EDX
MOV EDX,[EBX+4]
MOV [EBX+4],EAX
MOV [EBX+8],EDX
JMP @@qt
@@m2: TEST EDI,EDI
JNLE @@m3
MOV EAX,[EBX+4]
MOV EDX,[EBX+8]
MOV [EBX+4],EDX
MOV EDX,[EBX+12]
MOV [EBX+8],EDX
MOV [EBX+12],EAX
JMP @@qt
@@m3: MOV EAX,[EBX]
MOV EDX,[EBX+12]
CALL ESI
MOV ECX,[EBX]
MOV EDX,[EBX+4]
MOV EDI,[EBX+8]
MOV [EBX],EDI
MOV EDI,[EBX+12]
MOV [EBX+12],EDX
TEST EAX,EAX
JNLE @@m4
MOV [EBX+4],ECX
MOV [EBX+8],EDI
JMP @@qt
@@m4: MOV [EBX+4],EDI
MOV [EBX+8],ECX
@@qt: POP EDI
POP ESI
POP EBX
end;
procedure IntTinySort(ItemList: PPointerItemList; Count: Integer;
CompareFunction: TCompareFunction);
begin
if Count > 2 then
begin
if Count = 4 then
IntSort4(ItemList, CompareFunction)
else
IntSort3(ItemList, CompareFunction)
end
else if (Count = 2) and (CompareFunction(ItemList^[0], ItemList^[1]) > 0) then
begin
Count := Integer(ItemList^[0]);
ItemList^[0] := ItemList^[1];
ItemList^[1] := Pointer(Count);
end;
end;
{ Функции для сортировки массива указателей }
procedure IntRotateRight(P: Pointer; Count: Cardinal);
asm
MOV ECX,[EAX+EDX*4]
JMP DWORD PTR @@wV[EDX*4]
@@wV : DD @@w00, @@w01, @@w02, @@w03
DD @@w04, @@w05, @@w06, @@w07
DD @@w08, @@w09, @@w10, @@w11
DD @@w12, @@w13, @@w14, @@w15
@@w15: MOV EDX,[EAX+56]
MOV [EAX+60],EDX
@@w14: MOV EDX,[EAX+52]
MOV [EAX+56],EDX
@@w13: MOV EDX,[EAX+48]
MOV [EAX+52],EDX
@@w12: MOV EDX,[EAX+44]
MOV [EAX+48],EDX
@@w11: MOV EDX,[EAX+40]
MOV [EAX+44],EDX
@@w10: MOV EDX,[EAX+36]
MOV [EAX+40],EDX
@@w09: MOV EDX,[EAX+32]
MOV [EAX+36],EDX
@@w08: MOV EDX,[EAX+28]
MOV [EAX+32],EDX
@@w07: MOV EDX,[EAX+24]
MOV [EAX+28],EDX
@@w06: MOV EDX,[EAX+20]
MOV [EAX+24],EDX
@@w05: MOV EDX,[EAX+16]
MOV [EAX+20],EDX
@@w04: MOV EDX,[EAX+12]
MOV [EAX+16],EDX
@@w03: MOV EDX,[EAX+8]
MOV [EAX+12],EDX
@@w02: MOV EDX,[EAX+4]
MOV [EAX+8],EDX
@@w01: MOV EDX,[EAX]
MOV [EAX+4],EDX
@@w00: MOV [EAX],ECX
end;
procedure IntInsertionSort(ItemList: PPointerItemList; Count: Integer;
CompareFunction: TCompareFunction);
var
I, J: Integer;
begin
I := 1;
while I < Count do
begin
J := I - 1;
while J >= 0 do
begin
if CompareFunction(ItemList^[I], ItemList^[J]) >= 0 then
Break;
Dec(J);
end;
Inc(J);
if I <> J then
IntRotateRight(@ItemList^[J], I - J);
Inc(I);
end;
end;
procedure IntroSort(L, R: Integer; ItemList: PPointerItemList;
CompareFunction: TCompareFunction; DepthLimit: Integer);
var
I, J: Integer;
P, T: Pointer;
begin
I := L;
J := R;
if DepthLimit = 0 then
begin
Dec(J, I);
G_MakeHeap(@ItemList^[I], J + 1, CompareFunction);
G_SortHeap(@ItemList^[I], J + 1, CompareFunction);
Exit;
end;
Dec(DepthLimit);
P := ItemList^[(I + J) shr 1];
if CompareFunction(ItemList^[I], P) <= 0 then
begin
if CompareFunction(P, ItemList^[J]) > 0 then
if CompareFunction(ItemList^[I], ItemList^[J]) <= 0 then
P := ItemList^[J]
else
P := ItemList^[I];
end
else if CompareFunction(ItemList^[I], ItemList^[J]) <= 0 then
P := ItemList^[I]
else if CompareFunction(P, ItemList^[J]) <= 0 then
P := ItemList^[J];
repeat
while CompareFunction(ItemList^[I], P) < 0 do Inc(I);
while CompareFunction(ItemList^[J], P) > 0 do Dec(J);
if I <= J then
begin
T := ItemList^[I];
ItemList^[I] := ItemList^[J];
ItemList^[J] := T;
Inc(I);
Dec(J);
end;
until I > J;
if J - L > 15 then
IntroSort(L, J, ItemList, CompareFunction, DepthLimit)
else
IntInsertionSort(@ItemList^[L], J - L + 1, CompareFunction);
if R - I > 15 then
IntroSort(I, R, ItemList, CompareFunction, DepthLimit)
else
IntInsertionSort(@ItemList^[I], R - I + 1, CompareFunction);
end;
procedure G_Sort(ItemList: PPointerItemList; Count: Integer; CompareFunction: TCompareFunction);
begin
if Count < 17 then
begin
IntInsertionSort(ItemList, Count, CompareFunction);
Exit;
end;
IntroSort(0, Count - 1, ItemList, CompareFunction, G_Log2(Count) * 2);
end;
procedure IntMergeLoop(InList, OutList: PPointerItemList; Step, Count: Integer;
CompareFunction: TCompareFunction);
var
I1, I2, DoubleStep: Integer;
begin
DoubleStep := Step * 2;
repeat
if Count < DoubleStep then
if Count > Step then
DoubleStep := Count
else
begin
G_CopyLongs(InList, OutList, Count);
Break;
end;
I1 := 0;
I2 := Step;
repeat
if CompareFunction(InList^[I1], InList^[I2]) <= 0 then
begin
PPointer(OutList)^ := InList^[I1];
Inc(I1);
Inc(LongWord(OutList), SizeOf(Pointer));
if I1 = Step then
begin
I1 := DoubleStep - I2;
G_CopyLongs(@InList^[I2], OutList, I1);
Inc(LongWord(OutList), I1 * SizeOf(Pointer));
Break;
end;
end else
begin
PPointer(OutList)^ := InList^[I2];
Inc(I2);
Inc(LongWord(OutList), SizeOf(Pointer));
if I2 = DoubleStep then
begin
I2 := Step - I1;
G_CopyLongs(@InList^[I1], OutList, I2);
Inc(LongWord(OutList), I2 * SizeOf(Pointer));
Break;
end;
end;
until False;
Inc(LongWord(InList), DoubleStep * SizeOf(Pointer));
Dec(Count, DoubleStep);
until Count = 0;
end;
procedure G_StableSort(ItemList: PPointerItemList; Count: Integer;
CompareFunction: TCompareFunction);
var
I: Integer;
Buffer: PPointerItemList;
begin
if Count < 17 then
begin
IntInsertionSort(ItemList, Count, CompareFunction);
Exit;
end;
I := 0;
Dec(Count, 4);
while I <= Count do
begin
IntSort4(@ItemList^[I], CompareFunction);
Inc(I, 4);
end;
Inc(Count, 4);
IntTinySort(@ItemList^[I], Count - I, CompareFunction);
GetMem(Buffer, Count * SizeOf(Pointer));
I := 4;
while I < Count do
begin
IntMergeLoop(ItemList, Buffer, I, Count, CompareFunction);
Inc(I, I);
IntMergeLoop(Buffer, ItemList, I, Count, CompareFunction);
Inc(I, I);
end;
FreeMem(Buffer);
end;
procedure IntDownHeap(ItemList: PPointerItemList; Index, Count: Integer;
P: Pointer; CompareFunction: TCompareFunction);
var
Top, J: Integer;
begin
Top := Index;
J := (Index * 2) + 2;
while J < Count do
begin
if CompareFunction(ItemList^[J], ItemList^[J - 1]) < 0 then
Dec(J);
ItemList^[Index] := ItemList^[J];
Index := J;
Inc(J, J + 2);
end;
if J = Count then
begin
ItemList^[Index] := ItemList^[J - 1];
Index := J - 1;
end;
J := (Index - 1) shr 1;
while (Index > Top) and (CompareFunction(ItemList^[J], P) < 0) do
begin
ItemList^[Index] := ItemList^[J];
Index := J;
J := (Index - 1) shr 1;
end;
ItemList^[Index] := P;
end;
{ Функции для бинарного поиска в отсортированном массиве указателей }
function G_BinarySearch(Value: Pointer; ItemList: PPointerItemList; Count: Integer;
MatchFunction: TMatchFunction): Integer;
var
L, M, C: Integer;
begin
if Count > 0 then
begin
L := 0;
Dec(Count);
while L <= Count do
begin
M := (L + Count) shr 1;
C := MatchFunction(Value, ItemList^[M]);
if C > 0 then
L := M + 1
else if C <> 0 then
Count := M - 1
else
begin
Result := M;
Exit;
end;
end;
end;
Result := -1;
end;
function G_BinarySearch(Value: Pointer; ItemList: PPointerItemList; Count: Integer;
MatchFunction: TMatchFunction; out Index: Integer): Boolean;
var
L, M, C: Integer;
begin
L := 0;
if Count > 0 then
begin
Dec(Count);
while L <= Count do
begin
M := (L + Count) shr 1;
C := MatchFunction(Value, ItemList^[M]);
if C > 0 then
L := M + 1
else if C <> 0 then
Count := M - 1
else
begin
Index := M;
Result := True;
Exit;
end;
end;
end;
Index := L;
Result := False;
end;
{ Функции для слияния сортированных массивов указателей }
{ Функции для работы с кучей }
procedure G_MakeHeap(ItemList: PPointerItemList; Count: Integer;
CompareFunction: TCompareFunction);
var
Parent: Integer;
begin
if Count > 1 then
begin
Parent := (Count - 2) shr 1;
repeat
IntDownHeap(ItemList, Parent, Count, ItemList^[Parent], CompareFunction);
if Parent = 0 then
Break;
Dec(Parent);
until False;
end;
end;
procedure G_SortHeap(ItemList: PPointerItemList; Count: Integer;
CompareFunction: TCompareFunction);
var
P: Pointer;
begin
while Count > 1 do
begin
Dec(Count);
P := ItemList^[Count];
ItemList^[Count] := ItemList^[0];
IntDownHeap(ItemList, 0, Count, P, CompareFunction);
end;
end;
end.
Соседние файлы в папке utils