1. 1. Создание и управление списковыми объектами

Модуль демонстрирует приемы работы со списковым классом, прототипами функций и динамической памятью.

unit common;

Interface

uses Classes, SysUtils;

type

{ Прототип функции сравнения }

TCompareFunc = function(aData1, aData2: Pointer): Integer;

{ Прототип процедуры сортировки }

TSortProc = procedure(aList: TList;

aFirst, aLast: Integer; aCompare: TCompareFunc);

function CompareLongWord(aData1, aData2: Pointer): Integer;

procedure InitList(Count: LongWord);

procedure DisposeList;

procedure PrintList;

procedure PrintItem(Index: LongWord);

procedure SaveList(FileName: string);

function OpenList(FileName: string; var Size: LongWord): Boolean;

var List: TList;

Implementation

{ Функция сравнения двух целых чисел, заданных своими указателями }

function CompareLongWord(aData1, aData2: Pointer): Integer;

begin

{ Значение первого элемента меньше значения второго }

if LongWord(aData1^) < LongWord(aData2^) then

Result:=-1 else

{ Значения элементов равны }

if LongWord(aData1^) = LongWord(aData2^) then

Result:=0 else

{ Значение первого элемента больше значения второго }

Result:=1;

end;

{ Инициализация массива случайными числами }

procedure InitList(Count: LongWord);

var

pw: ^LongWord;

i: LongWord;

begin

Randomize;

for i:=0 to Count-1 do

begin

New(pw);

pw^:=Random(1000);

List.Add(pw);

end;

end;

{ Вывод содержимого массива }

procedure PrintList;

var i: Integer;

begin

if List.Count > 0 then

for i:=0 to List.Count-1 do

WriteLn(IntToStr(i)+': '+IntToStr(LongWord(List.Items[i]^)));

end;

{ Вывод значения одного элемента массива, заданного своим порядковым номером }

procedure PrintItem(Index: LongWord);

begin

if List.Count > 0 then

WriteLn(IntToStr(Index)+': '+IntToStr(LongWord(List.Items[Index]^)));

end;

{ Освобождение всех элементов массива и самого массива }

procedure DisposeList;

var

pw: ^LongWord;

i: LongWord;

begin

if List.Count > 0 then

try

{ Освобождение памяти, на

которую указывают элементы массива }

for i:=0 to List.Count-1 do

begin

pw:=List.Items[i];

Dispose(pw);

end;

finally

{ Удаление объекта массива }

List.Free;

end;

end;

{ Сохранение содержимого массива в текстовом файле }

procedure SaveList(FileName: string);

var

TF: TextFile;

i: LongWord;

begin

AssignFile(TF, FileName);

try

ReWrite(TF);

for i:=0 to List.Count-1 do

Writeln(TF, LongWord(List.Items[i]^));

finally

CloseFile(TF);

end;

end;

{ Чтение содержимого выборки из текстового файла и инициализация массива }

function OpenList(FileName: string; var Size: LongWord): Boolean;

var

TF: TextFile;

pw: ^LongWord;

begin

Size:=0;

Result:=True;

try

AssignFile(TF, FileName);

try

Reset(TF);

repeat

New(pw);

Readln(TF, pw^);

List.Add(pw);

until Eof(TF);

finally

CloseFile(TF);

Size:=List.Count;

end;

except

Result:=False;

end;

end;

initialization

List:=TList.Create;

finalization

DisposeList;

end.

2. 2. Алгоритмы поиска и сортировки

Модуль содержит реализации различных алгоритмов поиска по критерию отсортированных и неотсортированных объектов в списковом объекте класса TList. Все приведенные алгоритмы были рассмотрены в главе 4 и не требуют дополнительных пояснений.

unit srch;

interface

uses Classes, Common;

{ Алгоритмы поиска }

function LineNonSortedSearch(aList: TList;

aItem: Pointer; aCompare: TCompareFunc): Integer;

function LineSortedSearch(aList: TList;

aItem: Pointer; aCompare: TCompareFunc): Integer;

function BinarySearch(aList: TList;

aItem: Pointer; aCompare: TCompareFunc): Integer;

function BinaryRecurSearch(aList: TList;

aItem: Pointer; L,R: Integer; aCompare: TCompareFunc): Integer;

implementation

{ Линейный поиск в неотсортированном массиве }

function LineNonSortedSearch;

var i: Integer;

begin

Result:=-1;

for i:=0 to aList.Count-1 do

if aCompare(aList.List[i],aItem) = 0 then

begin

Result:=i;

Break;

end;

end;

{ Линейный поиск в отсортированном массивом }

function LineSortedSearch;

var i, CompareResult: Integer;

begin

Result:=-1;

{ Искать первый элемент, больший или равный искомому }

for i:=0 to aList.Count-1 do

begin

CompareResult:=aCompare(aList.List[i], aItem);

if CompareResult >= 0 then

begin

if CompareResult = 0 then

Result:=i else

Result:=-1;

Exit;

end;

end;

end;

{ Двоичный поиск }

function BinarySearch;

var L, R, M, CompareResult: Integer;

begin

{ Значения индексов первого и последнего элементов }

L:=0; R:=aList.Count-1;

while L <= R do

begin

{ Индекс среднего элемента }

M:=(L + R) div 2;

{ Сравнить значение среднего элемента с искомым }

CompareResult:=aCompare(aList.List[M], aItem);

{ Если значение среднего элемента меньше искомого -

переместить левый индекс на позицию до среднего индекса }

if CompareResult < 0 then

L:=M+1 else

{ Если значение среднего элемента больше искомого -

переместить правый индекс на позицию после среднего индекса }

if CompareResult > 0 then

R:=M-1 else

begin

Result:=M;

Exit;

end;

end;

Result:=-1;

end;

{ Рекурсивный алгоритм двоичного поиска }

function BinaryRecurSearch;

var i, CompareResult: Integer;

begin

{ Проверка ширины интервала }

if L > R then

Result:=-1 else

begin

i:=(L + R) div 2;

CompareResult:=aCompare(aList.List[i], aItem);

{ Ключ найден, возврат индекса }

if CompareResult = 0 then

Result:=i else

if CompareResult = -1 then

{ Поиск в правом подинтервале }

Result:=BinaryRecurSearch(aList,aItem,i+1,R,aCompare) else

{ Поиск в левом подинтервале }

Result:=BinaryRecurSearch(aList,aItem,L,i-1,aCompare);

end;

end;

end.

Модуль содержит реализации различных алгоритмов сортировки элементов в списковом объекте класса TList. Все приведенные алгоритмы были рассмотрены в главе 4 и не требуют дополнительных пояснений.

unit sort;