:: Pascal Page :: Динамические структуры данных (ООП-реализация)

Динамические структуры данных (ООП реализация)

Примеры использования: №1 :: №2

Вот тут я уже приводил одну из реализаций модуля, позволяющего работать со списком данных любого типа... Но, все-таки, у приведенного там метода есть несколько недостатков, а именно:

Для того, чтобы иметь возможность использовать такие структуры, нужно иметь исходные тексты реализации, нельзя передать пользователю уже откомпилированный модуль (в виде TPU-файла).
Нельзя не дублируя модули одну и ту же реализацию queue использовать для работы с разными типами.

В реализации, представленной ниже, я попытался избежать этих недостатков, и теперь для использования ДСД достаточно подключить TPU файл, и нет необходимости править его исходник...

Но, как известно, "если в одном месте прибудет, в другом обязательно убудет..." (С)

В данном случае это выражается в расходе чуть большего объема памяти, чем в предыдущем варианте.

Итак...

Для того, чтобы сделать реализацию Стека (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;

Теперь немного о тех членах/методах, назначение которых не совсем ясно:

Check, Good(). Для того, чтобы понять их назначение, нужно вспомнить, что при объявлении процедуры/функции, например, таким образом:
```
Procedure P(X: p_base);
```
фактически в нее можно передавать не только указатель на базовый тип, а так же и указатель на любой тип-наследник (что, собственно, и называется "полиморфизм")... С одной стороны, мы этого и добивались (как раз и нужно было, чтобы структура могла работать с любым типом, а не только с каким-то одним, жестко заданным при компиляции, как это было в предыдущих реализациях).

Но, с другой стороны, было бы крайне нежелательно при таком объявлении:
```
type
  derived_1 = object(base)
    ...
  end;
  derived_2 = object(base)
    ...
  end;
```
иметь возможность в одну и ту же структуру передавать указатель как на derived_1, так и на derived_2, т.е., скажем, в стек целых чисел не должны попадать символы, а в очереди строк совсем не место числам с плавающей запятой...

Для того, чтобы этого избежать, при инициализации структуры в нее передается некое фиктивное значение, которое в дальнейшем и используется при проверке "а может ли этот тип передаваться в данную структуру?", которая и производится функцией Good()... А в переменной Check как раз и хранится то самое фиктивное значение, с которым производится сравнение
Operation. Давайте подумаем, что происходит при извлечении элемента из структуры (например, стека)? Содержимое поля данных возвращается как результат функции, и элемент (titem), на который указывает "голова", удаляется... Это прекрасно реализуется при использовании стандартных типов, но вот с остальными опять возникает проблема, функция не может вернуть, например, запись...

Можно, как я уже предлагал раньше, возвращать указатель на поле данных, но ведь при удалении titem-а, этот указатель будет указывать в пустоту...

Я пошел другим путем: копирую указатель на элемент данных в переменную Operation, и удаляю titem... При этом сам элемент данных из памяти не удаляется, а находится там до выполнения следующей операции извлечения...

Вот реализация методов TBase (я добавил комментарии, чтобы было попроще разобраться...)

(*
  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.

Как видим - все отработало, как и положено...

Ну, а вот пример практического использования очереди (TQueue) для решения задачи.

Недавно на форуме был задан вопрос: Последовательный вывод индексов

"Каким бы образом сделать так, чтобы на вывод шёл не только первый встреченный искомый элемент с его местоположением (ну например максимальный), но и другие равные ему, с их родными индексами?"

Было предложено решение с использованием дополнительного массива, но давайте попробуем решить эту задачу и с использованием очереди, чтобы убедиться, что структуры действительно способны работать с разными типами...

Прежде всего, нам понадобится очередь, хранящая пары целых чисел; определим тип - наследник base с необходимой функциональностью, и после этого решим задачу:

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.

Как видим, программа опять выдала правильный результат...