Динамические структуры данных (ООП реализация) | |
Примеры использования: №1 :: №2 | |
Вот тут я уже приводил одну из реализаций модуля, позволяющего работать со списком данных любого типа... Но, все-таки, у приведенного там метода есть несколько недостатков, а именно:
Для того, чтобы сделать реализацию Стека (stack), Очереди (queue), и Дека (deque) не зависящей от типа данных, воспользуемся наследованием:
реализуем работу структуры с типом-предком, тогда она сможет работать и с типом-потомком.
Вот общий предок для всех типов, с которыми будут работать перечисленные структуры данных:
type p_base = ^base; base = object constructor init; destructor done; virtual; { Процедура вывода элемента на экран - переопределить для конкретного типа-потомка } procedure print; virtual; { Функция сравнения элементов данного типа - в потомке должна быть переопределена } function eq(const X: base): boolean; virtual; end;Эти методы - абстрактные, то есть в базовом типе просто оставляем их пустыми:
constructor base.init; begin end; destructor base.done; begin end; procedure base.print; begin end; function base.eq(const X: base): boolean; begin eq := false end;Теперь опишем тип titem, который, собственно, и представляет собой элемент структуры:
type ptitem = ^titem; titem = object info: p_base; { указатель на данные } next, prev: ptitem; { указатели на предыдущий/следующий элемент } constructor init(x: p_base; nxt, prv: ptitem); destructor done; end; ... { Реализация методов: } constructor titem.init(x: p_base; nxt, prv: ptitem); begin info := x; next := nxt; prev := prv; end; destructor titem.done; begin end;И, собственно, базовый класс для структуры (да, да, здесь тоже будет использоваться наследование...):
type TError = (structOk, structOverflow, structUnderflow, structType); TBase = object private { Все, что только можно - объявляем приватно, интерфейс будет предоставлен потомками } LastError: TError; { признак ошибки (на будущее - пока не используется) } Check, Operation: p_base; { Назначение объясню чуть позже } Len: LongInt; { количество элементов в структуре } first, last: ptitem; { "голова" и "хвост" структуры } { при печати структуры будет выводить на экран истинный её тип ("stack", "queue", "deque") } function iAm: string; virtual; constructor init(p: p_base); destructor done; virtual; procedure PutFirst(T: p_base); function GetFirst: p_base; procedure PutLast(T: p_base); function GetLast: p_base; function Top: p_base; procedure FreeNode(var p: ptitem); function Good(var T: p_base): boolean; { Об этом тоже расскажу... } public { Ну, а это должно объявляться "общим", т.к. будет использоваться и в вызывающей программе } function IsEmpty: boolean; procedure Clear; procedure Print; function GetLen: LongInt; end;Теперь немного о тех членах/методах, назначение которых не совсем ясно:
Procedure P(X: p_base);фактически в нее можно передавать не только указатель на базовый тип, а так же и указатель на любой тип-наследник (что, собственно, и называется "полиморфизм")... С одной стороны, мы этого и добивались (как раз и нужно было, чтобы структура могла работать с любым типом, а не только с каким-то одним, жестко заданным при компиляции, как это было в предыдущих реализациях).
type derived_1 = object(base) ... end; derived_2 = object(base) ... end;иметь возможность в одну и ту же структуру передавать указатель как на derived_1, так и на derived_2, т.е., скажем, в стек целых чисел не должны попадать символы, а в очереди строк совсем не место числам с плавающей запятой...
(* tbase realization *) constructor TBase.Init(p: p_base); begin first := nil; last := nil; { Заносим в "контрольную" переменную допустимый для использования указатель } Check := p end; destructor TBase.Done; begin Clear; { Удаляем из структуры все элементы... } { ... не забывая и про "контрольный указатель" } Dispose(Check, Done); end; function TBase.Good(var T: p_base): boolean; begin { Вернет true только при совпадении "контрольного" и полученного типов } Good := ( TypeOf(Check^) = TypeOf(T^) ); end; procedure TBase.PutFirst(T: p_base); var p: ptitem; begin LastError := structType; { Возможна ошибка "Неправильный тип" } if not Good(T) then Exit; { Если тип все-таки неправильный - просто выходим, ничего не добавляя в структуру } LastError := structOverflow; { Теперь возможна ошибка "Переполнение" } new(p, init(T, first, nil)); { Инициализируем элемент структуры } if p <> nil then begin if isEmpty then last := p else first^.prev := p; first := p; inc(Len); { Увеличиваем счетчик элементов } LastError := structOk; { Все в порядке, ошибок нет } end; end; procedure TBase.PutLast(T: p_base); var p: ptitem; begin LastError := structType; if not Good(T) then Exit; LastError := structOverflow; new(p, init(T, nil, last)); if p <> nil then begin if isEmpty then first := p else last^.next := p; last := p; inc(Len); LastError := structOk; end; end; function TBase.GetFirst: p_base; var ToDelete: ptitem; begin LastError := structUnderflow; { Возможна ошибка "Извлечение из пустой структуры" } if IsEmpty then Exit; { Если структура - пустая, то выходим } ToDelete := first; first := first^.next; if first <> nil then first^.prev := nil else last := nil; if Operation <> nil then { Если Operation <> nil, значит удаляем данные, хранящиеся с ПРЕДЫДУЩЕГО извлечения ... } Dispose(Operation, Done); Operation := ToDelete^.info; { ... запоминаем указатель на данные для СЕЙЧАС извлекаемого элемента ... } GetFirst := Operation; { ... возвращаем этот же указатель как результат функции ... } FreeNode(ToDelete); { ... и удаляем titem (не удаляя при этом данные) } LastError := structOk end; function TBase.GetLast: p_base; var ToDelete: ptitem; begin LastError := structUnderflow; if IsEmpty then Exit; ToDelete := last; last := last^.prev; if last <> nil then last^.next := nil else first := nil; if Operation <> nil then Dispose(Operation, Done); Operation := ToDelete^.info; GetLast := Operation; FreeNode(ToDelete); LastError := structOk end; { Является ли структура пустой? } function TBase.IsEmpty: Boolean; begin IsEmpty := (first = nil) end; procedure TBase.FreeNode(var p: ptitem); { Удаление заданного titem-а } begin Dispose(p); Dec(Len); { Не забываем уменьшать счетчик } p := nil end; procedure TBase.Clear; { Очистка структуры данных } begin while not isEmpty do GetFirst; { Пока что-то есть, удалять первый элемент } if Operation <> nil then begin { И (если есть) удаляем данные для считанного элемента } Dispose(Operation, Done); Operation := nil; end; end; procedure TBase.Print; var pt: ptitem; begin writeln(iAm + 'contents:'); if isEmpty then write('(empty)') else begin pt := first; while pt <> nil do begin pt^.info^.print; { Используем метод Print для вывода элемента данных } if pt^.next <> nil then write(', '); pt := pt^.next end; end; writeln end; function TBase.iAm: string; begin iAm := '' end; { Просто возвращаем указатель на данные, хранящиеся в "голове" структуры } function TBase.Top: p_base; begin Top := first^.info end; function TBase.GetLen: LongInt; begin GetLen := Len end;Теперь, когда базовый объект структуры определен, можно привести определение и реализацию наследников:
type tstack = object(TBase) private function iAm: string; virtual; public constructor init(p: p_base); destructor done; virtual; procedure Push(T: p_base); function Pop: p_base; function Top: p_base; end; (* Реализация *) constructor TStack.init(p: p_base); begin inherited Init(p) end; destructor TStack.done; begin inherited Done end; function TStack.iAm: string; begin iAm := 'Stack ' end; procedure TStack.Push(T: p_base); begin PutFirst(T) end; function TStack.Pop: p_base; begin Pop := GetFirst; end; function TStack.Top: p_base; begin Top := inherited Top; end;
type TQueue = object(TBase) private function iAm: string; virtual; public constructor init(p: p_base); destructor done; virtual; procedure Put(T: p_base); function Get: p_base; function Top: p_base; end; (* Реализация *) constructor TQueue.init(p: p_base); begin inherited Init(p) end; destructor TQueue.done; begin inherited Done End; function TQueue.iAm: string; begin iAm := 'Queue ' end; procedure TQueue.Put(T: p_base); begin PutLast(T); end; function TQueue.Get: p_base; begin Get := GetFirst; end; function TQueue.Top: p_base; begin Top := inherited Top; end;
type TDeq = object(TBase) private function iAm: string; virtual; public constructor init(p: p_base); destructor done; virtual; procedure PutStart(T: p_base); procedure PutFinish(T: p_base); function GetStart: p_base; function GetFinish: p_base; end; (* Реализация *) constructor TDeq.Init(p: p_base); begin inherited Init(p) end; destructor TDeq.Done; begin inherited Done end; function TDeq.iAm: string; begin iAm := 'Deq ' end; procedure TDeq.PutStart(T: p_base); begin PutFirst(T) end; procedure TDeq.PutFinish(T: p_base); begin PutLast(T) end; function TDeq.GetStart: p_base; begin GetStart := GetFirst; end; function TDeq.GetFinish: p_base; begin GetFinish := GetLast; End;
Теперь о том, как, собственно, использовать данный модуль...
Я создал еще один, дополнительный файл, содержащий описания основных встроенных типов... Чтобы не заниматься рутинной работой самому, я просто подключаю этот дополнительный модуль, и использую его. Вот фрагмент этого доп. модуля:unit std_type; interface uses struct; type pTint = ^Tint; { Для работы с целыми числами } Tint = object(base) value: integer; constructor init(X: integer); procedure print; virtual; function eq(const X: base): boolean; virtual; end; { Эта функция - для облегчения работы с типом Tint } function _int(X: integer): pTint; type pTchar = ^Tchar; { Для работы с символами } Tchar = object(base) value: char; constructor init(X: char); procedure print; virtual; function eq(const X: base): boolean; virtual; end; { Эта функция - для облегчения работы с типом Tchar } function _char(X: char): pTchar; implementation {*** Integer ***} function _int(X: integer): pTint; begin _int := new(pTint, init(X)); end; constructor Tint.init(X: integer); begin inherited init; value := X; end; procedure Tint.print; begin write(value); end; function Tint.eq(const X: base): boolean; begin if typeof(self) = typeof(X) then eq := (pTint(@X)^.value = value) else eq := false; end; {*** Char ***} function _char(X: char): pTchar; begin _char := new(pTchar, init(X)); end; constructor Tchar.init(X: char); begin inherited init; value := X; end; procedure Tchar.print; begin write(value); end; function Tchar.eq(const X: base): boolean; begin if typeof(self) = typeof(X) then eq := (pTchar(@X)^.value = value) else eq := false; end; end.Всё !!! Теперь структуры можно использовать.
Вот небольшой пример использования:
uses struct, std_type; { Подключаем модули } var mS, mS2: TStack; begin mS.Init(_int(0)); { mS будет работать только с целыми числами (т.к. использовали _int при инициализации) } mS2.Init(_char(#0)); { а mS2 - с данными символьного типа (инициализировали "контрольную переменную" через _char) } mS.Push(_int(1)); mS.Push(_int(2)); mS.Push(_int(5)); { *** Это значение не должно быть занесено в целочисленный стек !!! *** } mS.Push(_char('F')); mS.Push(_int(7)); mS.Print; WriteLn('Len = ', mS.GetLen); While not mS.IsEmpty Do begin mS.Pop^.print; writeln; end; mS2.Push(_char('A')); {'A'} mS2.Push(_char('B')); {'B', 'A'} mS2.Push(_char('F')); {'F', 'B', 'A'} mS2.Push(_char('G')); {'G', 'F', 'B', 'A'} mS2.Print; WriteLn('Len = ', mS2.GetLen); While not mS2.IsEmpty Do begin mS2.Pop^.print; writeln; end; ms2.Done; mS.Done; end.Как видим - все отработало, как и положено...
"Каким бы образом сделать так, чтобы на вывод шёл не только первый встреченный искомый элемент с его местоположением (ну например максимальный), но и другие равные ему, с их родными индексами?"Было предложено решение с использованием дополнительного массива, но давайте попробуем решить эту задачу и с использованием очереди, чтобы убедиться, что структуры действительно способны работать с разными типами...
uses struct; type pPair = ^pair; pair = object(base) one, two: integer; { Тип содержит только 2 целых числа } constructor init(a, b: integer); procedure print; virtual; end; { Описываем конструктор нового типа } constructor pair.init(a, b: integer); begin inherited init; one := a; two := b; end; { И определяем для него функцию печати } procedure pair.print; begin write(one, ':', two); end; { Просто для облегчения вызова конструктора } function _pair(a, b: integer): pPair; begin _pair := new(pPair, init(a, b)); end; { Это матрица на которой проверяется работоспособность программы } const n = 5; arr: array[1 .. n, 1 .. n] of integer = ( (1, 2, 3, 4, 5), (1, 7, 3, 4, 5), (1, 2, 3, 4, 5), (1, 2, 3, 7, 5), (7, 2, 3, 4, 5) ); var queue: TQueue; max, i, j: integer; begin queue.init(_pair(0, 0)); { Инициализируем очередь ("рабочий" тип - Pair) } max := - maxint; for i := 1 to n do begin for j := 1 to n do begin if arr[i, j] > max then begin max := arr[i, j]; queue.clear; { Если найден новый максимум - очистить очередь } queue.put(_pair(i, j)); { и внести в нее координаты элемента } end else if arr[i, j] = max then { если текущий элемент РАВЕН максимальному } queue.put(_pair(i, j)); { ДОБАВЛЯЕМ его координаты в очередь } end; end; queue.print; { И распечатываем очередь ... } queue.done; end.Как видим, программа опять выдала правильный результат...