Применяем дженерики в RAD Studio Delphi. Создаем библиотеку сортировки списков однотипных объектов

Сегодня будем создавать в RAD Studio Delphi библиотеку классов, реализующих сортировку списков однотипных объектов.

Цель задачи

Прикладной разработчик должен получить инструмент для создания дочерних классов, в которых можно:

• оперировать с объектами списка;
• применять различные правила сравнения объектов;
• применять различные алгоритмы сортировки объектов.

На выходе должна получиться библиотека классов, которая позволяет:

• прикладному разработчику сортировать любой из 100 объектов любым из 100 методов сортировки;
• дорабатывать и поддерживать новые алгоритмы или новые типы объектов в течении одного дня силами одного специалиста.

При создании необходимо учесть, что решение должно удовлетворять следующей модели:

• Количество алгоритмов сортировки - 100;
• Типы объектов доступных для сортировки - 100;
• Количество разработчиков, одновременно работающих с библиотекой, для создания типов объектов и алгоритмов сортировки - 100.
• Время разработки всех алгоритмов сортировки и типов объектов - 2 дня.

Приступаем

Сортировка по возрастанию - это перестановка элементов набора данных таким образом, чтобы в результате каждый последующий элемент набора был больше предыдущего. Сортировка по убыванию - то же самое, только обход результирующего набора данных нужно начинать с конца.

Сравнение объектов

Чтобы понять, какой элемент набора данных больше другого, для базовых типов необходимо применять оператор сравнения. А как быть с объектами? Базовый модуль System.Generics.Defaults включает в себя нужный нам интерфейс и реализацию класса

IComparer = interface function Compare(const Left, Right: T): Integer; end; TComparer = class(TInterfacedObject, IComparer) public class function Default: IComparer; class function Construct(const Comparison: TComparison): IComparer; function Compare(const Left, Right: T): Integer; virtual; abstract; end;
В интерфейсе видим единственный метод Compare вида

TComparison
На входе два параметра типа объект, а на выходе целое число (0 - объекты равны, -1 - первый меньше второго, 1 - первый больше второго).

Для сравнения наших объектов будем использовать свои функции сравнения, которые описывают логику правил сравнения для каждого типа объектов. Заключим такие функции в отдельный класс TAllComparison . В нем и описываются все наши функции сравнения, они имеют тот же вид

TComparison = reference to function(const Left, Right: T): Integer;
А класс TComparer(T) как раз служит для сравнения двух объектов путем вызова метода Compare .
Можно использовать сравнение по умолчанию (Default ), или создать свой метод сравнения Construct , чем мы и займемся.

Для удобства описание всех объектов будем хранить в отдельном модуле AllObjects . Здесь же будем хранить описание всех 100 созданных нами объектов.

Операции с объектами

Для осуществления операций с объектами списка в Delphi уже имеется нужный нам параметризированный класс, он же дженерик, с нужными нам методами

TList = class(TEnumerable)
Вообще, универсальные параметризированные типы (дженерики) появились еще в Delphi 2009, но для нашего примера я использую RAD Studio Berlin 10.1 UPD1. Если у вас что-то не компилируется, нужно будет допилить пример для своей версии Delphi.

Пишем основной класс нашей библиотеки наследник TList(T)

// Основной класс для работы со списком однотипных объектов type TAppliedObjectList = class(TList) private type TSorting = reference to function(var Values: array of T; const Comparer: IComparer; Index, Count: Integer): Integer; var FCS: TCriticalSection; // операции с переносом элементов списка делаем потоконезависимыми FComparer: IComparer; // хранится выбранный метод сравнения объектов списка Target: Array of T; // временный массив элементов, который передается в метод сортировки // создан, потому что массив элементов в родительском классе Private public constructor Create; overload; constructor Create(const AComparer: IComparer); overload; destructor Destroy; override; // здесь будем размещать дополнительные публичные методы для оперирования над объектами // универсальный метод сортировки с указанием нужного метода // возвращает количество перестановок, надеюсь, что их будет меньше MaxInt function SortBy(const AProc: TSorting): Integer; overload; end;
Основной метод нашей задачи SortBy , опишем его использование далее.

Сортировка объектов

Пишем класс TAllSort , который содержит описание всех 100 методов сортировки вида:

TSorting ; Index, Count: Integer): Integer;
На входе метод получает массив данных из списка, метод сравнения объектов, начальную позицию для сортировки, количество элементов в наборе. На выходе получаем количество произведенных в наборе данных перестановок.

Type // Методы сортировки должны быть вида TSorting TSorting = reference to function; Index, Count: Integer): Integer; // Основной класс, содержит все 100 методов сортировки TAllSort = class public // *** Сортировка пузырьковым методом class function BubbleSort(var Values: array of T; const Comparer: IComparer; Index, Count: Integer): Integer; // *** Быстрая сортировка class function QuickSort(var Values: array of T; const Comparer: IComparer; Index, Count: Integer): Integer; end;
Для удобства, все методы сортировки будем держать в отдельном модуле SortMethods .

Демонстрация

В качестве демонстрации решения представляю 2 механизма сортировки: «Быстрая» и «Пузырьком». Сортировать будем 2 типа объектов: список двумерных векторов (упорядоченные пары) типа Integer и список со строками.

Для начала отсортируем массив строк «пузырьками»:

Procedure TfmMainTest.Button4Click(Sender: TObject); var // объявляем переменную типа TAppliedObjectList // указываем, что список будет хранить объекты типа строка MyClass: TAppliedObjectList; i: Integer; begin Memo1.Clear; try // создаем экземпляр нашего класса, // в качестве метода сравнения будем использовать стандартный сравниватель для строк // типа IComparer MyClass:= TAppliedObjectList.Create(TComparer.Default); try Memo1.Lines.Text:= "Мой друг художник и поэт в дождливый вечер на стекле" + sLineBreak + "Мою любовь нарисовал, открыв мне чудо на земле." + sLineBreak + "Сидел я молча у окна и наслаждался тишиной" + sLineBreak + "Моя любовь с тех пор всегда была со мной." + sLineBreak + "И время как вода текло и было мне всегда тепло," + sLineBreak + "Когда в дождливый вечер я смотрел в оконное стекло." + sLineBreak + "Но год за годом я встречал в глазах любви моей печаль," + sLineBreak + "Дождливой скуки тусклый след и вот, любовь сменила цвет." + sLineBreak + "Моя любовь сменила цвет, угас чудесный яркий день" + sLineBreak + "Мою любовь ночная укрывает тень." + sLineBreak + "Веселых красок болтовня, игра волшебного огня" + sLineBreak + "Моя любовь уже не радует меня."; // заполняем список строками из Memo for i:= 0 to Memo1.Lines.Count - 1 do begin MyClass.Add(Memo1.Lines[i]); end; // вызываем метод сортировки "пузырьками" i:= MyClass.SortBy(TAllSort.BubbleSort); // выводим количество перестановок Memo1.Lines.Add(sLineBreak + "Turns: " + i.ToString); // выводим полученный список Memo1.Lines.Add("Полученный список:"); for i:= 0 to MyClass.Count - 1 do begin Memo1.Lines.Add(MyClass.Items[i]); end; finally // не забываем удалить экземпляр, когда закончили с ним работать MyClass.Free; end; except on E: Exception do Memo1.Lines.Add(E.Message); end; end;
Получили результат:

А теперь «быстро» отсортируем массив двумерных векторов:

Procedure TfmMainTest.Button3Click(Sender: TObject); var // объявляем переменную типа TAppliedObjectList // указываем, что список будет хранить объекты типа TVector2D MyClass: TAppliedObjectList; // вспомогательная переменная типа TVector2D v: TVector2D; i: Integer; begin Memo1.Clear; try // создаем экземпляр нашего класса списка, // в качестве метода сравнения будем использовать // метод TAllComparison.Compare_TVector2D MyClass:= TAppliedObjectList.Create (TComparer.Construct(TAllComparison.Compare_TVector2D)); try // заполняем список объектами типа 2D вектор Memo1.Lines.Add("Исходный список:"); v.Create(10, 21); MyClass.Add(v); Memo1.Lines.Add(v.ToString); v.Create(-10, 20); MyClass.Add(v); Memo1.Lines.Add(v.ToString); v.Create(-10, -2); MyClass.Add(v); Memo1.Lines.Add(v.ToString); v.Create(-1, 7); MyClass.Add(v); Memo1.Lines.Add(v.ToString); // вызываем метод "бычстрой" сортировки i:= MyClass.SortBy(TAllSort.QuickSort); // выводим количество перестановок Memo1.Lines.Add(sLineBreak + "Turns: " + i.ToString); // выводим полученный список Memo1.Lines.Add("Полученный список:"); for i:= 0 to MyClass.Count - 1 do begin Memo1.Lines.Add(MyClass.Items[i].ToString); end; finally // не забываем удалить экземпляр, когда закончили с ним работать if Assigned(MyClass) then MyClass.Free; end; except on E: Exception do Memo1.Lines.Add(E.Message); end; end;
Вот такой результат получился с векторами:

Указатели и динамические переменные позволяют создавать сложные динамические структуры данных, такие как списки и деревья.

Список можно изобразить графически (рис. 8.5).

Рис. 8.5. Графическое изображение списка

Каждый элемент списка (узел) представляет собой запись, состоящую из двух частей. Первая часть - информационная. Вторая часть отвечает за связь со следующим и, возможно, с предыдущим элементом списка. Список, в котором обеспечивается связь только со следующим элементом, называется односвязным.

Для того чтобы программа могла использовать список, надо определить тип компонентов списка и переменную-указатель на первый элемент списка. Ниже приведен пример объявления компонента списка студентов:

type TPStudent = """TStudent; // указатель на переменную типа TStudent

// описание типа элемента списка TStudent = record

surname: string; // фамилия

name: string; // имя

group: integer; // номер труппы

address: string; // домашний адрес

Next: TPStudent; // указатель на следующий элемент списка end;

var head: TPStudent; // указатель на первый элемент списка

Добавлять данные можно в начало, в конец или в нужное место списка. Во всех этих случаях необходимо корректировать указатели. На рис. 8.6 изображен процесс добавления элементов в начало списка.

Рис. 8.6. Добавление элементов в список

Следующая программа, ее текст приведен в листинге 8.4, формирует список студентов, добавляя фамилии в начало списка. Данные вводятся в поля редактирования диалогового окна программы (рис. 8.7) и добавляются в список нажатием кнопки Добавить (ви№оп1).

Рис. 8.7. Окно программы Динамический список 1

\ Листинг 8.4. Добавление элемента в начало динамического списка

Unit dlistl_; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForml = class(TForm) Label1: TLabel; Label2: TLabel; Label3: TLabel;

Editl: TEdit; // фамилия

Edit2: TEdit; // имя

Buttonl: TButton; // кнопка Добавить

Button2: TButton; // кнопка Показать

Procedure ButtonlClick(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Forml: TForml;

{$R *.DFM} type TPStudent=/4TStudent; // указатель на тип TStudent

TStudent = record

f_name:string; // фамилия l_name: string; // имя

next: TPStudent; // следующий элемент списка

var head: TPStudent; // начало (голова) списка

// добавить элемент в начало списка

Procedure TForml.ButtonlClick(Sender: TObject); var curr: TPStudent; // новый элемент списка begin new(curr); // выделить память для элемента списка сиггл.f_name:= Edit1.Text; сиггл.l_name:= Edit2.Text; // добавление в начало списка curгл.next:= head; head:= curr; // очистить поля ввода Editl.text:=""; Edit2.text:=""; end;

// вывести список

procedure TForml.Button2Click(Sender: TObject); var curr: TPStudent; // текущий элемент списка n:integer; // длина (кол-во элементов) списка

st:string; // строковое представление списка

Begin n:= 0; st:= " ; curr:= head; // указатель на первый элемент списка while curr о NIL do begin n:= n + 1; st:= st + сиггл.£_пате + " " + сиггл.1_пате +#13; curr:= curгл.next; // указатель на следующий элемент end;

Then ShowMessage("Список:" + #13 + st) else ShowMessage("В списке нет элементов."); end; end.

Добавление элемента в список выполняет процедура TFormi.Buttoniciick, которая создает динамическую переменную-запись, присваивает ее полям значения, соответствующие содержимому полей ввода диалогового окна, и корректирует значение указателя head.

Вывод списка выполняет процедура TForml. Button2ciick, которая запускается нажатием кнопки Показать. Для доступа к элементам списка используется указатель curr. Сначала он содержит адрес первого элемента списка. После того как первый элемент списка будет обработан, указателю curr присваивается значение поля next той записи, на которую указывает curr. В результате этого переменная curr содержит адрес второго элемента списка. Таким образом, указатель перемещается по списку. Процесс повторяется до тех пор, пока значение поля next текущего элемента списка (элемента, адрес которого содержит переменная curr) не равно nil.

Что такое дженерики и зачем они нужны?
Наличие обобщений в языке позволяет создавать открытые типы, которые превращаются в закрытые на этапе компиляции. Синтаксис дженериков на примере обобщенной записи TPoint приведен в Листинге 1 :
Листинг 1 - Объявление обобщенной записи TPoint
type TPoint = record X: T; Y: T; end; Сразу бросаются в глаза отличия от декларирования обычной записи - наличие в имени записи и кооринат X и Y этого же типа T . T здесь - неуточненный тип, который будет указан позже, при создании конкретного экземпляра записи.
Предположим, что мы решили использовать в приложении "дробные" точки (например, Double ). Все, что нужно сделать - объявить следующий закрытый тип:
Листинг 2 - Использование обобщенной записи TPoint в качестве "дробной" точки
... var MyPoint: TPoint; begin MyPoint.X:= 1.5; MyPoint.Y:= -0.5; ... А если нам понадобится целый тип, мы просто изменим Double на Integer :
Листинг 3 - Использование обобщенной записи TPoint в качестве "целой" точки
... var MyPoint: TPoint; begin MyPoint.X:= 1; MyPoint.Y:= 100; ... Просто, не правда ли? MyPoint: TPoint и MyPoint: TPoint - уже являются закрытыми типами и подчиняются все правилам, справедливым для обычных, необобщенных типов.

Может возникнуть вопрос: могу ли я сделать это без дженериков? Конечно, можете. Правда, лишитесь ряда преимуществ.

[Часть 1 - Введение в дженерики] [

Динамический список 3
unit dlist3_; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class (TForm) Label1: TLabel; Label2: TLabel; Button1: TButton; Button2: TButton; Label3: TLabel; Edit1: TEdit; Edit2: TEdit; Button3: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormActivate(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private declarations } public { Public declarations } end ; var Form1: TForm1; implementation {$R *.DFM} type TPStudent = ^TStudent; //указатель на тип TStudent TStudent = record f_name: string ; // фамилия l_name: string ; // имя next: TPStudent; // следующий элемент списка end ; var head: TPStudent; // начало (голова) списка procedure TForm1.Button1Click(Sender: TObject); var node: TPStudent; // новый узел списка curr: TPStudent; // текущий узел списка pre: TPStudent; // предыдущий, относительно curr, узел begin new(node); // создание нового элемента списка node^.f_name:= Edit1.Text; node^.l_name:= Edit2.Text; // добавление узла в список // сначала найдем подходящее место в списке для узла curr:= head; pre:= nil ; { Внимание! если приведенное ниже условие заменить на (node.f_name>curr^.f_name)and(curr<>NIL) то при добавлении первого узла возникает ошибка времени выполнения, так как curr = NIL и, следовательно, переменной curr.^name нет! В используемом варианте условия ошибка не возникает, так как сначала проверяется условие (curr <> NIL), значение которого FALSE и второе условие в этом случае не проверяется. } while (curr <> nil ) and (node.f_name > curr^.f_name) do begin // введенное значение больше текущего pre:= curr; curr:= curr^.next; // к следующему узлу end ; if pre = nil then begin // новый узел в начало списка node^.next:= head; head:= node; end else begin // новый узел после pre, перед curr node^.next:= pre^.next; pre^.next:= node; end ; Edit1.text:= ""; Edit2.text:= ""; Edit1.SetFocus; end ; procedure TForm1.Button2Click(Sender: TObject); var curr: TPStudent; // текущий элемент списка n: integer; // длина (кол-во элементов) списка st: string ; // строковое представление списка begin n:= 0; st:= ""; curr:= head; while curr <> nil do begin n:= n + 1; st:= st + curr^.f_name + " " + curr^.l_name + #13; curr:= curr^.next; end ; if n <> 0 then ShowMessage("Список:" + #13 + st) else ShowMessage("В списке нет элементов."); end ; procedure TForm1.FormActivate(Sender: TObject); begin head:= nil ; end ; // щелчок на кнопке Удалить procedure TForm1.Button3Click(Sender: TObject); var curr: TPStudent; // текущий, проверяемый узел pre: TPStudent; // предыдущий узел found: boolean; // TRUE - узел, который надо удалить, есть в списке begin if head = nil then begin MessageDlg("Список пустой!", mtError, , 0); Exit; end ; curr:= head; // текущий узел - первый узел pre:= nil ; // предыдущего узла нет found:= FALSE; // найти узел, который надо удалить while (curr <> nil ) and (not found) do begin if (curr^.f_name = Edit1.Text) and (curr^.l_name = Edit2.Text) then found:= TRUE // нужный узел найден else // к следующему узлу begin pre:= curr; curr:= curr^.next; end ; end ; if found then begin // нужный узел найден if MessageDlg("Узел будет удален из списка!", mtWarning, , 0) <> mrYes then Exit; // удаляем узел if pre = nil then head:= curr^.next // удаляем первый узел списка else pre^.next:= curr.next; Dispose(curr); MessageDlg("Узел" + #13 + "Имя:" + Edit1.Text + #13 + "Фамилия:" + Edit2.Text + #13 + "удален из списка.", mtInformation, , 0); end else // узла, который надо удалить, в списке нет MessageDlg("Узел" + #13 + "Имя:" + Edit1.Text + #13 + "Фамилия:" + Edit2.Text + #13 + "в списке не найден.", mtError, , 0); Edit1.Text:= ""; Edit1.Text:= ""; Edit1.SetFocus; end ; end . Скачать