Implementando una HashTable en Delphi

Las tablas de dispersión (Hash Table) son muy utilizadas en el diseño de software cuando lo datos que tenemos son pocos y queremos un coste muy bajo a la hora de acceder a estos. Mediante esta estructura de datos, podremos insertar un objeto con un coste O(1) y sacarlo con un coste O(1) mediante una función de dispersión. Todos los conceptos matemáticos relacionados con esta estructura de datos ya los estudiamos en la universidad (muchas asignaturas hablan de esto, Matemática Discreta, Estructura de la Información, etc).
Aquí os propongo un ejemplo que he recuperado de StackFrame y que lo he adaptado para crear una THashTable eficiente y sin fugas de memoria. Como muchos de vosotros ya sabréis existen muchas estructuras de datos (no solo las listas que requieren un recorrido secuencial para obtener sus elementos) como Arboles Binarios, Colas enlazadas, Colas prioritarias, Tablas de dispersión, etc. Y es muy importante que tengamos en cuenta dichos elementos para que nuestra aplicación sea eficiente y que el acceso a los datos sea rápido según lo requiramos.
La parte más importante de la tabla de dispersión es la función de dispersión, que se monta a través de algún identificador. Este identificador pasa por una función matemática (Hash Function) el cual devuelve una posición en la tabla.

Un ejemplo seria el siguiente:


El ejemplo que os adjunto en este post, consiste en una tabla de longitud fija y cada posición de la tabla tiene asociado un TObjectList que irá creciendo en función de las colisiones que tengamos en la tabla. Es decir, cuando un identificador del objeto a almacenar tenga la misma posición que otro objeto, éste se almacenará detrás del primer elemento, y esto provoca una colisión. Por lo tanto, tenemos que asegurarnos que las colisiones sean muy pocas y la tabla quede bien balanceada para que la búsqueda de valores continúe siendo rápida.

THashTable:

//*****************************
//@Author : Jordi Coll
//HastTable
//*****************************

unit HashTable;

interface

uses
    SysUtils, Variants, Classes, Controls, Contnrs;

type
    THashItem = class(TObject)
    private
        FId: string;
        FData: TObject;
    public
        constructor Create(Id: string; Data: TObject);
        destructor Destroy(); override;
        property Id: string read FId write FId;
        property Data: TObject read FData write FData;
    end;

type
    THashTable = class
    protected
        FTableSize: integer;
        function HashFunction(AId: string): integer; virtual;
    public
        FData: array of TObjectList;
        constructor Create(tableSize: integer);
        destructor Destroy(); override;
        procedure Add(Id: string; Data: TObject);
        function items(Id: string): TObject;
        procedure Delete(AId: string);
        procedure ClearAll;
    end;

implementation

{ THashItem }

constructor THashItem.Create(Id: string; Data: TObject);
begin
    FId := Id;
    FData := Data;
end;

destructor THashItem.Destroy;
begin
  inherited;
  FreeAndNil(FData);
end;

{ THashTable }

procedure THashTable.ClearAll;
var
    i: integer;
begin
    for i := 0 to FTableSize - 1 do
        FData[i].Clear;
end;

constructor THashTable.Create(tableSize: integer);
var
    i: integer;
begin
    FTableSize := tableSize;
    SetLength(FData, tableSize);
    for i := 0 to FTableSize-1 do
        FData[i] := TObjectList.Create();
end;

function THashTable.HashFunction(AId: string): integer;
var
    i: integer;
    h, x: longint;
begin
    h := 0;
    for i := 1 to Length(AId) do
    begin
        h := (h shl 8) + Ord(AId[i]);
        x := h and $F000F000;
        if x <> 0 then
            h := h xor (x shr 21) xor x;
    end;
    result := h mod FTableSize;
end;

procedure THashTable.Add(Id: string; Data: TObject);
var
    hash, i: integer;
    list: TObjectList;
    item: THashItem;
begin
    hash := HashFunction(Id);
    list := TObjectList(FData[hash]);
    for i := 0 to list.Count - 1 do
    begin
        item := THashItem(list[i]);
        if item.Id = Id then
        begin
            item.Data := Data;
            exit;
        end;
    end;
    list.Add(THashItem.Create(Id, Data));
end;

function THashTable.items(Id: string): TObject;
var
    hash, i: integer;
    list: TList;
    item: THashItem;
begin
    result := nil;
    hash := HashFunction(Id);
    list := TObjectList(FData[hash]);
    for i := 0 to list.Count - 1 do
    begin
        item := THashItem(list[i]);
        if item.Id = Id then
        begin
            result := item.Data;
            break;
        end;
    end;
end;

procedure THashTable.Delete(AId: string);
var
    hash, i: integer;
    list: TObjectList;
begin
    hash := HashFunction(AId);
    list := TObjectList(FData[hash]);
    for i := 0 to list.Count - 1 do
        if THashItem(list[i]).Id = AId then
        begin
            list.Delete(i);
            break;
        end;
end;

destructor THashTable.Destroy;
var
    i : integer;
begin
    inherited;
    for i := 0 to FtableSize - 1 do
        FreeAndNil(FData[i]);
end;

end.

Ejemplo de utilización de la tabla:

procedure TForm3.Button1Click(Sender: TObject);
var
    hash: THashTable;
    obj: TTest;
    sText: string;
    i, j: integer;
    hashItem: THashItem;
begin
    memo1.clear;
    FormCreate(Sender);
    sText := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
    hash := THashTable.Create(20);
    for i := 0 to StrToInt(Edit1.text) do
    begin
        obj := TTest.CreateTest(i + 1, sText[1 + random(26)]);
        hash.Add(IntToStr(obj.id), obj);
    end;
    for i := 0 to Length(hash.FData) - 1 do
    begin
        if hash.FData[i].Count <> 0 then
        begin
            sText := IntToStr(i);
            for j := 0 to hash.FData[i].Count - 1 do
            begin
                hashItem := THashItem(hash.FData[i].Items[j]);
                sText := sText + ' -> |' + IntToStr(TTest(hashItem.Data).Id) + ' - ' + TTest(hashItem.Data).value + '| ';
            end;
            AddPosShape(i + 1, hash.FData[i].Count);
            memo1.lines.Add(sText);
        end
        else
            memo1.lines.Add(IntToStr(i) + ' -> null');
    end;

    //Obtener un item
    obj := TTest(hash.items('100'));
    showMessage(IntToStr(obj.id) + ' - ' + obj.value);


    hash.ClearAll;
    FreeAndNil(hash);
end;

Programa de ejemplo, mostrando las diferentes entradas y colisiones:

Mediante esta pequeña herramienta que hice, podemos ver como mediante la función de dispersión se van almacenando los elementos de una manera balanceada evitando la agrupación masiva en uno de los registros de la tabla. De esta manera los datos quedan bien almacenados, aunque es solo un ejemplo, y realmente la tabla tendría que tener como menos colisiones mejor.

• Otras implementaciones:

En el siguiente enlace, podemos encontrar otra implementación de Hash Table, creada por kktos. Este ejemplo lo podemos encontrar en SWAG, una página dedicada a contener un montón de ejemplos para Pascal. Si podéis pasar por ella, hay bastantes ejemplos y mucho código. Aunque es bastante vieja (del año 97), pero tiene cosas interesantes.

En la red, podemos encontrar incluso vídeos explicativos de diferentes universidades. Aquí os dejo uno sobre los HashTables de la universidad de California (Berkley):

• Enlaces de interés:

Introducción a las HashTables.
Implementación de una HashTable en C.
Introducción Algorítmica : Hashing1, Hashing2.