Статьи Королевства Дельфи

Продолжение


Раздел Поземелье Магов
Оглавление.
  1. Организация данных в виде связанных указателями структур.

§3 Организация данных в виде связанных указателями структур.

Актуальность задачи распределения и перераспределения памяти сохранилась, когда появились 32-разрядные ОС и СРП, позволяющие адресоваться из одного массива данных к оперативной памяти размером до 4 Гбайт, так как редко встречаются алгоритмы, обходящиеся одним массивом, как правило, их бывает несколько и в случае, если в алгоритме используется память полиномиального размера [2], перед разработчиком встает вопрос о способах организации данных. Прежде чем подавать на вход алгоритма исходные данные, надо договориться о том как они представляются в "понятном для компьютера виде". До появления в СРП Delphi 4, вышедшем в 1998 г., новой структуры данных, под названием динамический массив (ДМ), который позволяет работать с массивами данных, резервируя место в памяти по мере необходимости, при программировании на Pascal обходились линейными списками [1]. При программировании на Delphi для организации списков можно воспользоваться классом (объектом) TList из модуля classes, но требуется дополнительное программирование объектов наследников от TList. Возможны две нотации: 1) либо наследовать от TList

TDataListI = class (TList) // (1*) protected procedure Put(Index: Integer; Item: TData); function Get (Index: Integer): TData; public procedure Add (Obj: TData); property Items[Index: Integer]: TData read Get write Put; default; end; 2) либо вставлять класс TList в класс контейнер (оболочку)

TDataListW = class(TObject) // (2*) private FList: TList; function Get(Index: Integer): TData; procedure Put(Index: Integer; Item: TData); function GetCount: Integer; public constructor Create; destructor Destroy; override; function Add(Item: TData): Integer; function Equals(List: TDataListW): Boolean; property Count: Integer read GetCount; property Items[Index: Integer]: TData read Get write Put; default; end; Тип TData, как правило, является классом, но может быть любым типом. Если тип элемента не класс сложнее освободить память, т.к. операции освобождения ложатся не на функцию Destroy, принадлежащую классу, а на дополнительные модули или операторы в Ваших модулях. Как видно из описания классов унификация внутри модуля относительно типа элементов (записи, класса и т. п.), из которых состоят списки, существует только для классов, Т.к. только классы "знают" как себя освобождать. Для реализации этой идеи нужно переписать класс TDataListW, например, следующим образом:

TDataListС = class // (3*) private LType: TClass; FList: TList; function Get (Index: Integer): TObject; procedure Put (Index: Integer; Item: TObject); function GetCount: Integer; public constructor Create (CType: TClass); destructor Destroy; override; function Add (Item: TObject): Integer; function Equals(List: TDataListС): Boolean; property Count: Integer read GetCount; property Items [Index: Integer]: TObject read Get write Put; default; end; Идентификаторы методов в переводе отражают их предназначение. Тексты не приводятся в силу их тривиальности. В итоге, применяя методы Create и Add, можно создавать списки и добавлять в них новые элементы. Обращаться к элементам списков можно при помощи идентификатора Items или как к обычному элементу массива, т. к. свойство Items определено как default. Кроме того, в Delphi определены классы: TClassList и TObjectList (из модуля contnrs) наследуемые от Tlist и похожие на класс TDataListС; TStack, TObjectStack, TQueue, TОbjectQueue наследуемые от TOrderedList, реализующие различные виды линейных списков [1]; TCollection (из модуля classes) наследуемые от TPersistent, в котором реализована возможность синхронизации доступа к элементам благодаря методам BeginUpdate, EndUpdate; TStrings (из модуля classes) наследуемые от TPersistent, абстрактный базовый класс для манипуляции со строками; TStringList (из модуля classes) наследуемые от TStrings, управляющий списками строк и присоединённых к ним объектов с замещенными абстрактными методами из TStrings. Как видите, многообразие довольно широкое. Могут быть и проблемы. У всего 16 байт, но при интенсивной работе со списками это приводило к нехватке оперативной памяти. Поэтому, по-видимому, имеет право на существование подход, когда разработчик не использует чужих классов, а всё пишет сам. Это не сложно. Сначала создается запись, которая будет являться элементом списка.

PItem_Tree = ^TItem_Tree; TItem_Tree = record { Рабочая часть записи } ... {-------------------------------------------------} { Часть записи для организации списка } Next: PItem_Tree; end; Затем пишется класс, реализующий список.

TRecList = class // (4*) private Head, Last: PItem_Tree; BeforeSet: PItem_Tree; IndexBeforeSet: integer; BeforeGet: PItem_Tree; IndexBeforeGet: integer; FCount: integer; RetCode: byte; function GetItem(Index: integer): TItem_Tree; procedure SetItem(Index: integer; Rec: TItem_Tree); function Empty: boolean; function GetNodeSet(i:integer): PItem_Tree; function GetNodeGet(i:integer): PItem_Tree; protected function GetCount: integer; public constructor Create; destructor Destroy; override; procedure Clear; function Add(Rec: TItem_Tree): integer; virtual; function AddBegin(Rec: TItem_Tree): integer; virtual; procedure Assign(var Output: TRecList); procedure Insert(Index: integer; const Rec: TItem_Tree); virtual; procedure DeleteFromListCheckedFlagItog; procedure CopyRec(const Input: TItem_Tree; var Output: TItem_Tree); property Items[i: integer]:TItem_Tree read GetItem write SetItem;default; property Count: integer read GetCount; end; function TRecList.Empty:boolean; begin if Head <> nil then begin RetCode:=Succes; if Head^.Next=nil then Empty:=TRUE else Empty:=FALSE end else begin RetCode:=NotFill; Empty:=TRUE; end; end; procedure TRecList.CopyRec(const Input:TItem_Tree; var Output:TItem_Tree); begin with OUTPUT do begin { Присвоение рабочей части записи } ... { Часть записи для организации списка } Next:=nil; end; end; constructor TRecList.Create; begin inherited Create; Head:=nil; Last:=Head; Before:=Head; IndexBefore:=0; BeforeSet:=Head; IndexBeforeSet:=0; BeforeGet:=Head; IndexBeforeGet:=0; FCount:=0; end; destructor TRecList.Destroy; begin Clear; inherited Destroy; end; procedure TRecList.Clear; var P,P1:PItem_Tree; begin if Head<>nil then begin if Empty and (RetCode=Succes) then begin Dispose(Head); Head:=nil; RetCode:=Succes; Exit; end; P:=Head; while P<>nil do begin P1:=P^.Next; Dispose(P); P:=P1; end; RetCode:=Succes; Head :=nil; Last :=nil; Before :=nil; IndexBefore:=0; BeforeSet :=nil; IndexBeforeSet:=0; BeforeGet :=nil; IndexBeforeGet:=0; FCount:=0; end else RetCode:=NotFill; end; function TRecList.GetNodeSet(i:integer): PItem_Tree; var j: integer; P: PItem_Tree; begin RetCode:=Succes; if (i-1=IndexBeforeSet) and (BeforeSet <> nil) then begin P:=BeforeSet^.Next; BeforeSet:=P; IndexBeforeSet:=i; GetNodeSet:=P; end else begin P:=Head; j:=0; while P<>nil do begin if i=j then break; P:=P^.Next; Inc(j); end; BeforeSet:=P; IndexBeforeSet:=i; GetNodeSet:=P; end; end; function TRecList.GetNodeGet(i: integer): PItem_Tree; var j: integer; P: PItem_Tree; begin RetCode:=Succes; if (i-1=IndexBeforeGet) and (BeforeGet <> nil) then begin P:=BeforeGet^.Next; BeforeGet:=P; IndexBeforeGet:=i; GetNodeGet:=P; end else begin P:=Head; j:=0; while P<>nil do begin if i=j then break; P:=P^.Next; Inc(j); end; BeforeGet:=P; IndexBeforeGet:=i; GetNodeGet:=P; end; end; procedure TRecList.SetItem(Index: integer; Rec: TItem_Tree); var P, P1: PItem_Tree; begin if Index>FCount then begin RetCode:=ErrIndex; Exit; end; P:=GetNodeSet(Index); if RetCode=Succes then begin P1:=P^.Next; CopyRec(Rec, P^); P^.Next:=P1; end; end; function TRecList.GetItem(Index: integer): TItem_Tree; var P:PItem_Tree; begin if Index>FCount then begin RetCode:=ErrIndex; Exit; end; P:=GetNodeGet(Index); if RetCode=Succes then if P<>nil then CopyRec(P^, Result); end; function TRecList.Add(Rec: TItem_Tree): integer; begin if Head=nil then begin New(Head); if Head<>nil then begin CopyRec(Rec, Head^); Last:=Head; FCount:=1; Result:=1; end else Result:=-1; end else begin New(Last^.Next); Last:=Last^.Next; CopyRec(Rec, Last^); Inc(FCount); Result:=FCount; end; end; function TRecList.Addbegin(Rec: TItem_Tree): integer; var P: PItem_Tree; begin if Head=nil then begin New(Head); if Head<>nil then begin CopyRec(Rec, Head^); Last:=Head; FCount:=1; Result:=1; end else Result:=-1; end else begin New(P); P^.Next:=Head; Head:=P; P:=P^.Next; BeforeSet:=Head; IndexBeforeSet:=0; BeforeGet:=Head; IndexBeforeGet:=0; CopyRec(Rec, Head^); Head^.Next:=P; Inc(FCount); Result:=FCount; end; end; procedure TRecList.Assign(var Output: TRecList); begin output.Clear; output.Head:=Head; output.Last:=Last; output.BeforeSet:=BeforeSet; output.IndexBeforeSet:=IndexBeforeSet; output.BeforeGet:=BeforeGet; output.IndexBeforeGet:=IndexBeforeGet; output.FCount:=FCount; inherited Destroy; end; procedure TRecList.Insert(Index: integer; const Rec: TItem_Tree); var P,P1,P2:PItem_Tree; i: integer; begin New(P); Inc(FCount); CopyRec(Rec, P^); if Head=nil then Head:=P else { Если список не пуст } begin P1:=Head; P2:=Head; i:=0; while (P2<>nil) and (ido begin P1:=P2; P2:=P2^.Next; Inc(i) end; { Пройден весь список-элемент в конец } if P2=nil then P1^.Next:=P else begin P^.Next:=P2; { В начало списка } if P2=Head then Head:=P else { Внутрь списка } P1^.Next:=P end; end; end; function TRecList.GetCount: integer; begin GetCount:=FCount; end; procedure TRecList.DeleteFromListCheckedFlagItog; var P, P1: PItem_Tree; begin P:=Head; while P<>nil do if not P^.FlagItog then begin { Удаление из начала списка } if P=Head then begin Head:=Head^.Next; Dispose(P); Dec(FCount); P:=Head; end else begin { Удаление из середины списка } P1^.Next:=P^.Next; Dispose(P); Dec(FCount); P:=P1^.Next; end; end else begin { Переход на следующий элемент списка} P1:=P; P:=P^.Next; end; end; Метод Empty предназначен для проверки списка на наличие элементов, используется в других методах класса. CopyRec используется для заполнения элементов списка. Create и Destroy для создания и уничтожения списка соответственно. Clear - удаляет все элементы из списка. Методы GetNodeSet, GetNodeGet совместно с полями BeforeSet, IndexBeforeSet, BeforeGet, IndexBeforeGet используются как внутренние и обеспечивают простенькую оптимизацию без дополнительных связей, основанную на том, что при чтении и записи элементов подряд достаточно хранить индекс предыдущего элемента для проверки и ссылку на предыдущий элемент для выполнения действий. Этот способ оптимизации для однонаправленного списка сказывается, естественно, только для больших списков (сотни тысяч элементов). Методы SetItem и GetItem обслуживают доступ к элементам через свойство Items. Добавление элементов в конец, начало и указанное место списка обслуживается методами Add, AddBegin, Insert. Assign при помощи полей Head (указатель на первый элемент) и Last (указатель на последний элемент) поддерживает копирование из списка в список. DeleteFromListCheckedFlagItog тоже метод с "хитринкой". Если Вы, работая с большим списком, попытаетесь поэлементно удалять из него, это займет много времени. Однако, можно просто пометить какое-то поле в элементе вместо удаления, а затем, просматривая список один раз, удалить все помеченные элементы. Попутно отметим, что в объектах аналогичных выше приведенным возможно выполнять сжатие данных (хранить в элементах списка типы данных меньшего размера, чем данные, с которыми производятся какие-то действия). При программировании на Delphi для сжатия узла списка можно воспользоваться классом (объектом) TBits из модуля classes. В случае, если поля узла списка имеют тип массива байт, слов и т. п., можно при сохранении структуры в узле списка производить операции сжатия данных, например, как в функции приведённой ниже.

function ByteTo2Bit(B: array of Byte; var Bit: TBits): boolean; var i, j: integer; begin ByteTo2Bit:=True; Bit:=TBits.Create; Bit.Size:=Length(B)*2; for i:=Low(B) to High(B) do begin j:=(i-Low(B))*2; if B[i]=2 then Bit.Bits[j]:=True else if B[i]=1 then Bit.Bits[j+1]:=True; end; end; А при извлечении данных из узла списка для работы, использовать функцию Bit2ToByte.

function Bit2ToByte(Bit: TBits; var B: array of Byte): Boolean; var i, j: integer; begin Bit2ToByte:=True; if Length(B)*2 < Bit.Size then begin Bit2ToByte:=False; Exit; end; i:=0; while i<Bit.Size do begin j:=(i div 2)+Low(B); if Bit.Bits[i] then B[j]:=2 else if Bit.Bits[i+1] then B[j]:=1 else B[j]:=0; inc(i,2); end; end; В приведенной ниже таблицы представлены результаты тестирования классов типа TDataListW, поддерживающих динамические безразмерные списки без и со сжатием. Размер записи до сжатия составлял 3688 байт, после сжатия 68 байт. Тесты показывают, что при "навешивании" операций сжатия на класс динамических списков, память экономится в разы, а время обработки растёт на порядки. Из чего следует, что надо сжимать данные в списках, если другого выхода по алгоритму нет. В поддиректории "Списки" можно найти разложенные по поддиректориям исходные тексты модулей с классами, поддерживающими вышеописанный механизм хранения данных.

Тип объекта Размер списка Время счёта в [мин:]сек Затраченная ОП в Кбайт
Без сжатия 50000
100000
150000
200000
2
4
12
25
171000
343000
470000
472884
Со сжатием 10000
50000
100000
150000
500000
21
1:48
3:37
5:47
18:41
13560
62404
123472
184528
481372



Содержание раздела