Samoalokująca tablica

Samoalokująca tablica

Autorzy:
  • Artur Protasewicz
  • MSM


Celem artykułu jest pokazanie, jak stworzyć tablicę, której rozmiaru nie trzeba definiować.

W zależności od użytych indeksów tablica sama przyjmie odpowiedni rozmiar - wymagane jest tylko określenie typu: jedno-, dwu-, trzy- czy czterowymiarowa (w mojej praktyce spotkałem najwyżej tablice trójwymiarowe).
Tablica (indeksowana od zera) jest zbiorem elementów typu Variant, co jeszcze zwiększa jej elastyczność.
Należy ją utworzyć metodą Create, a zwalniać metodą Destroy (twój program zwolni ją na końcu procedury, w której została zadeklarowana) lub przy zamknięciu programu. Można też użyć metody Clear, która zwolni z pamięci wszystkie elementy tablicy, jednak nie zniszczy jej jako obiektu.

Ważną jej cechą jest to, że tworzy tylko niezbędne wektory np.:
A[2, 3] := 15

zaalokuje (0, 0, (0, 0, 0, 15)) - 6 bajtów - a nie ((0, 0, 0, 0), (0, 0, 0, 0), (0, 0, 0, 15)) - 12 bajtów (dokładniej mówiąc zamiast zer pojawią się wartości Unassigned)
Do niezainicjowanych pól można się odwoływać bez obawy o działanie programu:
  • odwołanie (do nieistniejącego elementu A[5, 7]) - string1 := A[5, 7] - spowoduje zaalokowanie elementu A[5, 7] i podstawienie pod string1 wartości '' (pustej).
  • odwołanie (do nieistniejącego elementu A[6, 8]) - int1 := A[6, 8] - spowoduje zaalokowanie elementu A[6, 8] i podstawienie pod int1 wartości 0.
  • itd.


Samoalokująca tablica przeznaczona jest raczej dla doświadczonych programistów, którym nieobcy jest debugger, ponieważ wykrycie błędów w indeksach i błędów w typach danych jest trudne.

Konwersje w typie Variant

Wszystkie typy całkowite, zmiennoprzecinkowe i boolowskie oraz niektóre przypadki string są kompatybilne, jeśli chodzi o podstawienia, z typem Variant, co obrazuje poniższy przykład.

Przykład

 
var
  v1, v2, v3, v4, v5: Variant;
  i: integer;
  d: double;
  s: string;
begin
  v1 := 1;              { wartość integer                     }
  v2 := 1234.5678;      { wartość real                        }
  v3 := 'Hello world!'; { wartość string                      }
  v4 := '1000';         { wartość string                      }
  v5 := v1 + v2 + v4;   { wartość real 2235.5678              }
  i  := v1;             { i = 1 (wartość integer)             }
  d  := v2;             { d = 1234.5678 (wartość real)        }
  s  := v3;             { s = 'Hello world!' (wartość string) }
  i  := v4;             { i = 1000 (wartość integer)          }
  s  := v5;             { s = '2235.5678' (wartość string)    }
end;
 


Tabela konwersji

Typ źródłowyTyp docelowyKonwersja
integerrealinteger na real
integerstringIntToStr
integerboolean0 na false, pozostałe na true
realintegerRound
realstringFloatToStr
realboolean0 na false, pozostałe na true
stringintegerStrToInt, może spowodować wyjątek
stringrealStrToFloat, może spowodować wyjątek
stringboolean'false' na false, 'true' na true (nie zależy od wielkości znaków), może spowodować wyjątek
booleanintegerfalse na 0, true: ustawia wszystkie bity na 1 (np. integer = -1, byte = 255)
booleanrealfalse na 0, true na 1
booleanstringfalse na 'False', true na 'True' (wielkość liter zależy od ustawień środowiska)
UnassignedInteger0
Unassignedstring'' (pusty string)
Unassignedbooleanfalse

  • Konwersja typu char dokonywana jest tak jak dla typu string


Jak tutaj działa alokacja?

Można tu albo wcale nie wstawiać komentarzy albo rozpisywać się bez końca.
Dla lepszego zobrazowania o co tu chodzi posłużę się zdaniem:
"Tu się nic nie dzieje niepotrzebnie."
i poniższym obrazkiem pokazującym 3 kolejne alokacje dla tej samej tablicy trójwymiarowej
(Uwaga: elementy, których nie widać nie istnieją, natomiast elementy, które widać jako puste prostokąty mają wartość Unassigned):





Interfejs 

 
unit UAutoAllocArray;
 
interface
 
uses
  Variants;
 
type
  TAutoAllocArrayDim1 = class(TObject) //tablica jednowymiarowa
    private
      FArr1: array of Variant;
      function  GetArr(aIndex: integer): Variant;
      procedure SetArr(aIndex: integer; aValue: Variant);
      procedure ReDim (aIndex: integer);
    public
      CannotAlloc: boolean; //jeśli true, alokacja się nie powiodła (zwykle przekroczono 2GB)
      procedure    Clear;
      property     Arr[aIndex: integer]: Variant read GetArr write SetArr; default;
            //ponieważ użyto default można się odwołać np. A[5] := 1, a nie A.Arr[5] := 1
      constructor  Create;
      destructor   Destroy; override;
  end;
 
type
  TAutoAllocArrayDim2 = class(TObject) //tablica dwuwymiarowa
    private
      FArr2: array of array of Variant;
      function  GetArr(aIndex1, aIndex2: integer): Variant;
      procedure SetArr(aIndex1, aIndex2: integer; aValue: Variant);
      procedure ReDim (aIndex1, aIndex2: integer);
    public
      CannotAlloc: boolean; //jeśli true, alokacja się nie powiodła (zwykle przekroczono 2GB)
      procedure    Clear;
      property     Arr[aIndex1, aIndex2: integer]: Variant read GetArr write SetArr; default;
            //ponieważ użyto default można się odwołać np. A[5, 6] := 1, a nie A.Arr[5, 6] := 1
      constructor  Create;
      destructor   Destroy; override;
  end;
 
type
  TAutoAllocArrayDim3 = class(TObject) //tablica trójwymiarowa
    private
      FArr3: array of array of array of Variant;
      function  GetArr(aIndex1, aIndex2, aIndex3: integer): Variant;
      procedure SetArr(aIndex1, aIndex2, aIndex3: integer; aValue: Variant);
      procedure ReDim (aIndex1, aIndex2, aIndex3: integer);
    public
      CannotAlloc: boolean; //jeśli true, alokacja się nie powiodła (zwykle przekroczono 2GB)
      procedure    Clear;
      property     Arr[aIndex1, aIndex2, aIndex3: integer]: Variant read GetArr write SetArr; default;
            //ponieważ użyto default można się odwołać np. A[5, 6, 2] := 1, a nie A.Arr[5, 6, 2] := 1
      constructor  Create;
      destructor   Destroy; override;
  end;
 
type
  TAutoAllocArrayDim4 = class(TObject) //tablica czterowymiarowa
    private
      FArr4: array of array of array of array of Variant;
      function  GetArr(aIndex1, aIndex2, aIndex3, aIndex4: integer): Variant;
      procedure SetArr(aIndex1, aIndex2, aIndex3, aIndex4: integer; aValue: Variant);
      procedure ReDim (aIndex1, aIndex2, aIndex3, aIndex4: integer);
    public
      CannotAlloc: boolean; //jeśli true, alokacja się nie powiodła (zwykle przekroczono 2GB)
      procedure    Clear;
      property     Arr[aIndex1, aIndex2, aIndex3, aIndex4: integer]: Variant read GetArr write SetArr; default;
            //ponieważ użyto default można się odwołać np. A[5, 6, 2, 12] := 1, a nie A.Arr[5, 6, 2, 12] := 1
      constructor  Create;
      destructor   Destroy; override;
  end;
 
implementation
 




Funkcje tablicy jednowymiarowej:

 
procedure TAutoAllocArrayDim1.Clear;
begin
  SetLength(FArr1, 0);
end;
 
constructor TAutoAllocArrayDim1.Create;
begin
  inherited;
  SetLength(FArr1, 0);
end;
 
destructor TAutoAllocArrayDim1.Destroy;
begin
  Clear;
  inherited;
end;
 
procedure TAutoAllocArrayDim1.ReDim(aIndex: integer);
{
Procedura sprawdza, czy użyty indeks jest większy od największego
użytego do tej pory. Jeżeli nie jest, nic nie robi w danym wymiarze tablicy.
Jeżeli jest, zwiększa rozmiar tablicy do użyty_index + 1 w danym wymiarze tablicy.
Tu: w wymiarze pierwszym.
}
begin
    try
      if Length(FArr1) < aIndex + 1 then
        SetLength(FArr1, aIndex + 1);
      CannotAlloc := false;
    except
      CannotAlloc := true;
    end;
end;
 
function TAutoAllocArrayDim1.GetArr(aIndex: integer): Variant;
begin
  ReDim(aIndex);
  Result := FArr1[aIndex];
end;
 
procedure TAutoAllocArrayDim1.SetArr(aIndex: integer; aValue: Variant);
begin
  ReDim(aIndex);
  FArr1[aIndex] := aValue;
end;
 





Funkcje tablicy dwuwymiarowej:

 
procedure TAutoAllocArrayDim2.Clear;
var
  i: integer;
begin
  for i := 0 to Length(FArr2) - 1 do
    SetLength(FArr2[i], 0);
  SetLength(FArr2, 0);
end;
 
constructor TAutoAllocArrayDim2.Create;
begin
  inherited;
  SetLength(FArr2, 0);
end;
 
destructor TAutoAllocArrayDim2.Destroy;
begin
  Clear;
  inherited;
end;
 
procedure TAutoAllocArrayDim2.ReDim(aIndex1, aIndex2: integer);
{
Procedura sprawdza, czy użyty indeks jest większy od największego
użytego do tej pory. Jeżeli nie jest, nic nie robi w danym wymiarze tablicy.
Jeżeli jest, zwiększa rozmiar tablicy do użyty_index + 1 w danym wymiarze tablicy.
Tu: w wymiarze pierwszym, drugim.
Istotna jest kolejność tej operacji:
      najpierw pierwszy wymiar,
      potem drugi wymiar.
}
begin
    try
      if Length(FArr2) < aIndex1 + 1 then
        SetLength(FArr2, aIndex1 + 1);
      if Length(FArr2[aIndex1]) < aIndex2 + 1 then
        SetLength(FArr2[aIndex1], aIndex2 + 1);
      CannotAlloc := false;
    except
      CannotAlloc := true;
    end;
end;
 
function TAutoAllocArrayDim2.GetArr(aIndex1, aIndex2: integer): Variant;
begin
  ReDim(aIndex1, aIndex2);
  Result := FArr2[aIndex1, aIndex2];
end;
 
procedure TAutoAllocArrayDim2.SetArr(aIndex1, aIndex2: integer; aValue: Variant);
begin
  ReDim(aIndex1, aIndex2);
  FArr2[aIndex1, aIndex2] := aValue;
end;
 




Funkcje tablicy trójwymiarowej:

 
procedure TAutoAllocArrayDim3.Clear;
var
  i, j: integer;
begin
  for i := 0 to Length(FArr3) - 1 do
  begin
    for j := 0 to Length(FArr3[i]) - 1 do
      SetLength(FArr3[i, j], 0);
    SetLength(FArr3[i], 0);
  end;
  SetLength(FArr3, 0);
end;
 
constructor TAutoAllocArrayDim3.Create;
begin
  inherited;
  SetLength(FArr3, 0);
end;
 
destructor TAutoAllocArrayDim3.Destroy;
begin
  Clear;
  inherited;
end;
 
procedure TAutoAllocArrayDim3.ReDim(aIndex1, aIndex2, aIndex3: integer);
{
Procedura sprawdza, czy użyty indeks jest większy od największego
użytego do tej pory. Jeżeli nie jest, nic nie robi w danym wymiarze tablicy.
Jeżeli jest, zwiększa rozmiar tablicy do użyty_index + 1 w danym wymiarze tablicy.
Tu: w wymiarze pierwszym, drugim, trzecim.
Istotna jest kolejność tej operacji:
      najpierw pierwszy wymiar,
      potem drugi wymiar,
      potem trzeci wymiar.
}
begin
    try
      if Length(FArr3) < aIndex1 + 1 then
        SetLength(FArr3, aIndex1 + 1);
      if Length(FArr3[aIndex1]) < aIndex2 + 1 then
        SetLength(FArr3[aIndex1], aIndex2 + 1);
      if Length(FArr3[aIndex1, aIndex2]) < aIndex3 + 1 then
        SetLength(FArr3[aIndex1, aIndex2], aIndex3 + 1);
      CannotAlloc := false;
    except
      CannotAlloc := true;
    end;
end;
 
function TAutoAllocArrayDim3.GetArr(aIndex1, aIndex2, aIndex3: integer): Variant;
begin
  ReDim(aIndex1, aIndex2, aIndex3);
  Result := FArr3[aIndex1, aIndex2, aIndex3];
end;
 
procedure TAutoAllocArrayDim3.SetArr(aIndex1, aIndex2, aIndex3: integer; aValue: Variant);
begin
  ReDim(aIndex1, aIndex2, aIndex3);
  FArr3[aIndex1, aIndex2, aIndex3] := aValue;
end;
 




Funkcje tablicy czterowymiarowej:

 
procedure TAutoAllocArrayDim4.Clear;
var
  i, j, k: integer;
begin
  for i := 0 to Length(FArr4) - 1 do
  begin
    for j := 0 to Length(FArr4[i]) - 1 do
    begin
      for k := 0 to Length(FArr4[i, j]) - 1 do
        SetLength(FArr4[i, j, k], 0);
      SetLength(FArr4[i, j], 0);
    end;
    SetLength(FArr4[i], 0);
  end;
  SetLength(FArr4, 0);
end;
 
constructor TAutoAllocArrayDim4.Create;
begin
  inherited;
  SetLength(FArr4, 0);
end;
 
destructor TAutoAllocArrayDim4.Destroy;
begin
  Clear;
  inherited;
end;
 
procedure TAutoAllocArrayDim4.ReDim(aIndex1, aIndex2, aIndex3, aIndex4: integer);
{
Procedura sprawdza, czy użyty indeks jest większy od największego
użytego do tej pory. Jeżeli nie jest, nic nie robi w danym wymiarze tablicy.
Jeżeli jest, zwiększa rozmiar tablicy do użyty_index + 1 w danym wymiarze tablicy.
Tu: w wymiarze pierwszym, drugim, trzecim, czwartym.
Istotna jest kolejność tej operacji:
      najpierw pierwszy wymiar,
      potem drugi wymiar,
      potem trzeci wymiar,
      potem czwarty wymiar.
}
begin
    try
      if Length(FArr4) < aIndex1 + 1 then
        SetLength(FArr4, aIndex1 + 1);
      if Length(FArr4[aIndex1]) < aIndex2 + 1 then
        SetLength(FArr4[aIndex1], aIndex2 + 1);
      if Length(FArr4[aIndex1, aIndex2]) < aIndex3 + 1 then
        SetLength(FArr4[aIndex1, aIndex2], aIndex3 + 1);
      if Length(FArr4[aIndex1, aIndex2, aIndex3]) < aIndex4 + 1 then
        SetLength(FArr4[aIndex1, aIndex2, aIndex3], aIndex4 + 1);
      CannotAlloc := false;
    except
      CannotAlloc := true;
    end;
end;
 
function TAutoAllocArrayDim4.GetArr(aIndex1, aIndex2, aIndex3, aIndex4: integer): Variant;
begin
  ReDim(aIndex1, aIndex2, aIndex3, aIndex4);
  Result := FArr4[aIndex1, aIndex2, aIndex3, aIndex4];
end;
 
procedure TAutoAllocArrayDim4.SetArr(aIndex1, aIndex2, aIndex3, aIndex4: integer; aValue: Variant);
begin
  ReDim(aIndex1, aIndex2, aIndex3, aIndex4);
  FArr4[aIndex1, aIndex2, aIndex3, aIndex4] := aValue;
end;
 
end.
 




Przykład użycia

 
procedure TFormMain.Button1Click(Sender: TObject);
var
  a: TAutoAllocArrayDim4;
  b: TAutoAllocArrayDim2;
  s: string;
  i: integer;
begin
  a := TAutoAllocArrayDim4.Create;
  b := TAutoAllocArrayDim2.Create;
  a[2, 1, 3, 1] := 'Artur';
  s := a[2, 1, 3, 1]; //s = 'Artur'
  s := a[4, 2, 0, 3]; //s = ''
  b[10, 7] := 33;
  i := b[10, 7]; // 33
  i := b[21, 8]; // 0
end;
 
 

Kategoria: Delphi » Gotowce

7 komentarzy

Avatar: Artur Protasewicz
Napisany 2011-07-10 07:52 przez Artur Protasewicz

Tytułem uzupełnienia w odpowiedzi na komentarz łapczaka...
Jeżeli napiszesz for i := 0 to 100000 do a[i] := 5, to alokacja ma miejsce w każdej iteracji.
Jeżeli napiszesz for i := 100000 to 0 do a[i] := 5, to alokacja ma miejsce tylko jeden raz.

Brak avatara
Napisany 2011-07-01 09:52 przez łapczak

Bardzo to wygodne, ale STRASZNIE WOLNE ... alokacja pamięci dla tablicy jest zapisywana przy dodaniu każdego nowego rekordu. Zapisanie 10 000+ rekordów już mija się z celem.

Avatar: Artur Protasewicz
Napisany 2011-02-16 14:48 przez Artur Protasewicz

Dziękuję madmike. Twoja wersja jest lepsza.

Brak avatara
Napisany 2011-02-16 13:32 przez madmike

Świetny artykuł

Dodałem tabelkę z typami konwersji - autor zdecyduje czy pozostawić - które rozwiązanie jest bardziej czytelne: spis czy tabela

Avatar: Artur Protasewicz
Napisany 2011-02-14 06:11 przez Artur Protasewicz

W metodach Clear poprawiłem na Length(Arr) - 1. 10 miesięcy tu jest ten artykuł i wydaje mi się, że był w miarę popularny, a nikt tego nie zauważył? Chyba, że wszyscy, którzy korzystali poprawili sobie sami.
Od niedawna mam stronę:
http://protasewicz.pl
na której akurat ten kod chciałem zamieścić i znalazłem ten błąd. Na stronie jest również trochę matematyczne rozwinięcie na wypadek, gdybyś akurat potrzebował tablicy np. 10-wymiarowej, chociaż regułę budowania kolejnych wymiarów można zaobserwować i tutaj i sądzę, że większość nie będzie miała problemu, ale może ktoś jednak będzie tego potrzebował.
Ostatnio rzadko tu bywam, więc pozdrawiam wszystkich.

Avatar: Artur Protasewicz
Napisany 2010-04-04 10:39 przez Artur Protasewicz

MSM, wielkie, wielkie dzięki za uporządkowanie tego tematu i zmobilizowanie mnie do roboty. Praca zespołowa się opłaca.

Avatar: Tezcatlipoca
Napisany 2010-04-03 10:07 przez Tezcatlipoca

Ciekawy pomysł z tą biblioteką, ale jak z wydajnością? I straszny bałagan w tym kodzie, dodałbyś chociaż jakieś komentarze, bo ciężko coś zrozumieć :/

Facebook
4programmers.net