unit wHashTable2;
{ Feel free to use this unit as you want.
  First developped by Bernard Gisin
  This unit serves to do Hash coding.
  What is Hash coding ?
  Suppose you would like an array[0..many billions] of pointer;
  But you know that all pointers are NIL, except a few hundert of them.
  Then, a table of only a few hundert of paires (index, pointer)
  would be enough.
  For example, corresponding to the array[0..string[60]] of pointer;
  could be coded in
  array[0..1008] of record
                       strIndex : string[60];
                       pT       : pointer;
                       end; // record
  if we know that less that 1009 pointers are non-NIL.
  ( 1009 is a prime number, which is a better choice than other numbers)

  Hash table implement this idea in a way that given an strIndex, the
  index in the array[0..1008] is very quickly computed.

  The two difficulties with Hash coding are :
  1) One must fixe a table size.
  2) Clearly, many  strIndex  will give the same value in [0..1008].
     Then another value in [0..1008] has to be made.

  For the moment, it is quite simple.
  We can only add a new correspondance (index, pointer)  and
  get back the pointer given the index.
  We cannot delete a data in the table.
----------------------------------}

// To tell FreePascal that the application is a Graphical User Interface
// i.e. is running in windows, not in text mode.
{$APPTYPE GUI}

INTERFACE
//"""""""

uses wGlobals2;

type
  // here, indexes are a paire of two word32 numbers.
  RTable = record
     wIndex1,
     wIndex2  : word32;
     pT       : pointer; // pointer associated to the index pair
     wInfo    : word32;  // An additional information can be used with it.

     wIndexNext : word32;
     // If there is a collision, give the next index where to search.
     // If it is =word32(-1) then there are no next index where to search
     end; // record

  TArrayRTable = array[0..1000000] of RTable;  // only pointers on it will be used
  PArrayRTable = ^TArrayRTable;

  // the Hash table object.
  PHashTableW2 = ^THashTableW2;
  THashTableW2 = object
  //"""""""""""""""""""
  pTable      : PArrayRTable;
  wTableSize  : word32;  // size allocated to store the table

  wNbElements : word32;
  // number of element in the table, corresponding to
  // non NIL pointers.

  pTableLast : PArrayRTable;
  // Is usually = NIL. But during increasing a table size, it's <> NIL.
  // Usefull to test that we don't ask to increase a table size
  // while we are increasing a table size.

  wTableSizeLast : word32;
  // Table size of the last and smallest table
  // while we are increasing the table size.
  // if (pTableLast = NIL) then it has no meaning

  constructor Init(wMaxSize:word32);
  // Allocate memory for tha table, and
  // set all table's pointers to NIL.
  // Put 0 if you want an automatic choise.
  // Putting a prime number is a good choice usually.

  destructor  Done; virtual;
  // desalocate the memory.

  procedure IncreaseTableSizeW2;
  // Increase the table size.
  // In fact, if pTable = NIL, it's the first time that
  // we allocate memory for the table.
  // Do not call it. It's done automatically when necessary.

  procedure IncreaseTableSizeAndAddW2(w1,w2,wInfoL:word32; pL:pointer);
  // To increase the table size and then add a new value in the table

  procedure AddPointerW2(w1,w2,wInfoL:word32; pL:pointer);
  // Add the corresponding pointer and the two indexes
  // in the table.

//  procedure DeletePointerW2(w1,w2:word32);  useless
  // To Delete a pointer associated with the two indexes (w1,w2),
  // just call  AddPointerW2(w1,w2,NIL);  nothing more !

  function GetPointerW2(w1,w2:word32; var wInfoV:word32):pointer;
  // given two word32, give the corresponding pointer
  // and the associated info word32
  // We accept an ambiguiy.
  // We return a NIL pointer if no corresponding indexes (w1, w2)
  // have been found in the table

  end; // THashTableW2 = object

IMPLEMENTATION
//""""""""""""

uses wErrors0, wDebug0;

var glnNotUsed : integer; // To avoid an error in the DevPascal 1.9 environment

//***************************************************
// TMDIClientWindow0 = object(TWindowBase)
//***************************************************

constructor THashTableW2.Init(wMaxSize:word32);
//=============================================
var ww : word32;
begin
// At the beginning, the table is empty.
wNbElements :=0;

pTableLast:=NIL;   wTableSizeLast:=0;
pTable:=NIL;       wTableSize    :=0;

if (wMaxSize > 1000000) then wMaxSize:=1000000; // little security, arbitrary

if (wMaxSize = 0) then wMaxSize:=1009; // automatic choice.

// Here we could just call  IncreaseTableSizeW2;
// and delete the rest of the constructor after the Error test.

GetMem(pTable, wMaxSize * SizeOf(RTable));

if (pTable = NIL) then begin
   // Not enough memory, we can do nothing.
   ErrorWrite(ERR_THashTableW2_Init_1, 'in THashTableW2.Init');
   ErrorComment( ERR_THashTableW2_Init_1,
                 'Cannot allocate the desired memory. Nothing allocated.');
   ErrorComment( ERR_THashTableW2_Init_1,
                 'Wanted table size =' + IntToStr(wMaxSize, 7));
   exit;
   end;

// remember the memory allocated.
wTableSize :=wMaxSize;

// Initialising
for ww:=0 to wTableSize-1 do begin
   pTable^[ww].pT      :=NIL;
   pTable^[ww].wInfo   :=0;
   pTable^[ww].wIndex1 :=0;
   pTable^[ww].wIndex2 :=0;
   pTable^[ww].wIndexNext:=word32(-1);
   end;
end;  // THashTableW2.Init

destructor THashTableW2.Done;
//===========================
begin
if (wTableSize = 0) then exit; // nothing to do

// free the allocated memory.
FreeMem(pTable, wTableSize * SizeOf(RTable));
end;  // THashTableW2.Done

procedure THashTableW2.IncreaseTableSizeW2;
//=========================================
// Increase the table size.
// In fact, if pTable = NIL, it's the first time that
// we allocate memory for the table.
// Do not call it. It's done automatically when necessary.
var
  ww : word32;
begin
if (pTableLast <> NIL) then begin
   ErrorWrite(ERR_THashTableW2_IncreaseTableSizeW2_1, 'in THashTableW2.IncreaseTableSizeW2');
   ErrorComment( ERR_THashTableW2_IncreaseTableSizeW2_1,
                 'This is a PROGRAMMING ERROR. pTableLast <> NIL !');
   ErrorComment( ERR_THashTableW2_IncreaseTableSizeW2_1,
                 'This should never occure. wTableSize =' + IntToStr(wTableSize, 7));
   exit;
   end;

pTableLast     :=pTable;
wTableSizeLast :=wTableSize;

if (pTable <> NIL) then begin
   // we must really increase the table size
   if      (2*wTableSize >= 100003) then begin
      // The table is really very big, but increase it more.
      wTableSize:=3*wTableSize;
      end
   else if (2*wTableSize >=  30011) then
      wTableSize:=100003
   else if (2*wTableSize >=  10007) then
      wTableSize:= 30011
   else if (2*wTableSize >    3001) then
      wTableSize:= 10007
   else if (2*wTableSize >    1009) then
      wTableSize:=3001
   else wTableSize:=1009; // smallest size when increases a table
   end;

// Get memory for the new table
GetMem(pTable, wTableSize * SizeOf(RTable));

if (pTable = NIL) then begin
   // we couldn't increase the table size
   if (pTableLast = NIL) then exit; // error will be given in the init part.

   // Not enough memory, we can do nothing. Very very very seldom
   ErrorWrite(ERR_THashTableW2_IncreaseTableSizeW2_2, 'in THashTableW2.IncreaseTableSizeW2');
   ErrorComment( ERR_THashTableW2_IncreaseTableSizeW2_2,
                 'Cannot allocate the desired memory to increase Hash table.');
   ErrorComment( ERR_THashTableW2_IncreaseTableSizeW2_2,
                 'Wanted table size =' + IntToStr(wTableSize, 7));

   // Keep as it was
   pTable     :=pTableLast;
   wTableSize :=wTableSizeLast;
   exit;
   end;

// Initialising the new table
wNbElements:=0;
for ww:=0 to wTableSize-1 do begin
   pTable^[ww].pT      :=NIL;
   pTable^[ww].wInfo   :=0;
   pTable^[ww].wIndex1 :=0;
   pTable^[ww].wIndex2 :=0;
   pTable^[ww].wIndexNext:=word32(-1);
   end;

if (pTableLast = NIL) then exit; // It's done.

// we have to copy the old table in the new one.
for ww:=0 to wTableSizeLast-1 do if (pTableLast^[ww].pT <> NIL) then begin
   // recursive call to AddPointerW2, who just call this procedure. But no problem
   AddPointerW2( pTableLast^[ww].wIndex1, pTableLast^[ww].wIndex2,
                 pTableLast^[ww].wInfo, pTableLast^[ww].pT);
   end;

// Free the memory of the previous (smaller) table.
FreeMem(pTableLast, wTableSizeLast * SizeOf(RTable));

pTableLast:=NIL; // finished increasing the table size.
end;  // THashTableW2.IncreaseTableSizeW2

procedure THashTableW2.IncreaseTableSizeAndAddW2(w1,w2,wInfoL:word32; pL:pointer);
//================================================================================
// To increase the table size and then add a new value in the table
begin
IncreaseTableSizeW2;

pTableLast:=pTable; // just to be <> NIL
AddPointerW2(w1,w2,wInfoL,pL);

pTableLast:=NIL; // finished adding the last point.
end;  // THashTableW2.IncreaseTableSizeAndAddW2

procedure THashTableW2.AddPointerW2(w1,w2,wInfoL:word32; pL:pointer);
//===================================================================
// Add the corresponding pointer and the two indexes
// in the table.
var
  wNbLoop,    // security, no to loop indefinitly
  wIndexLast, // Last index, used in case of collisions
  wIndex
              : word32;

begin
// if (pL = NIL) then exit; // then the filed will be cleared

// Check to see if the table size has to be increased.

if (6*wNbElements >= 5*wTableSize) and (pTableLast = NIL) then begin
   // table nearly full, and not in the process of increasing the table size
   // thus increase the table size
   IncreaseTableSizeW2;
   end;

// in most cases, this will be the key, but in case of collision,
// another key has to be choosen.
wIndex:=((w1 mod wTableSize) + (w2 mod wTableSize)) mod wTableSize;

wNbLoop:=0; // security
repeat
   // usually repeat only once, but in case of collision, repeat more.
   if (pTable^[wIndex].pT = NIL) then begin
      // a free place has been found.
      pTable^[wIndex].wIndex1   :=w1;
      pTable^[wIndex].wIndex2   :=w2;
      pTable^[wIndex].wInfo     :=wInfoL;
      pTable^[wIndex].pT        :=pL;
      inc(wNbElements ); // one more element
      // pTable^[wIndex].IndexNext = word(-1) normally.
      exit;
     end;

   // Maybe it's already in the table, in this case.
   // Replace the older pointer corresponding to (w1, w2)
   if (pTable^[wIndex].wIndex1 = w1) and
      (pTable^[wIndex].wIndex2 = w2) then begin
      pTable^[wIndex].wInfo   := wInfoL; // replace the old value
      pTable^[wIndex].pT      := pL;     // replace the old value
      exit;
      end;

   // memorises the index of the occupied place.
   wIndexLast:=wIndex;

   // a collision has been found, a new place is search.
   // First we loop over all chained indexes, to see if the
   // indexes (w1,w2) are already in the table
   wIndex:=pTable^[wIndex].wIndexNext;

   inc(wNbLoop);
   until (wIndex = word32(-1)) or
         (wNbLoop > 100); // should not occur that we loop so long

// There was collisions, and the indexes (w1, w2) are not already in the table
if (wIndex = word32(-1)) then begin
   // no next idem chained, thus compute a new one, to find some more place
   repeat
      wIndex:=Random(wTableSize);
      inc(wNbLoop);
      until (pTable^[wIndex].pT = NIL) or (wNbLoop > 100);

   if (pTable^[wIndex].pT = NIL) then begin
      // we found a new place, memorise it in the chain
      pTable^[wIndexLast].wIndexNext :=wIndex;
      pTable^[wIndex].wIndex1   :=w1;
      pTable^[wIndex].wIndex2   :=w2;
      pTable^[wIndex].wInfo     := wInfoL;
      pTable^[wIndex].pT        :=pL;
      inc(wNbElements ); // one more element
      // pTable^[wIndex].IndexNext = word(-1) normally.
      exit;
      end;
   end;

// here, we couldn't find more place in the array.
// Either because we are very very very unluky, or
// because the table is nearly full.
// thus the table size has to increase.

if (pTableLast = NIL) then begin
   // table nearly full, and not in the process of increasing the table size
   // thus increase the table size
   // And add the element which had problems to be added.
   IncreaseTableSizeAndAddW2(w1,w2,wInfoL,pL);;
   end
else begin  // here pTableLast <> NIL
   // Very difficult! Juste after increasing the table size,
   // while copying data from the smaller table to the bigger one,
   // the table size should be increased.
   ErrorWrite(ERR_THashTableW2_AddPointerW2_1, 'in THashTableW2.AddPointerW2');
   ErrorComment( ERR_THashTableW2_AddPointerW2_1,
                 'Very unlikly error. Hash table must be increased just after it has been increased. !');
   ErrorComment( ERR_THashTableW2_AddPointerW2_1,
                 'The element indexs = (' + IntToStr(w1,0) +
                 ', ' + IntToStr(w2,0) + ') has not been added to the Hash table');
   end;
end;  // THashTableW2.AddPointerW2

function THashTableW2.GetPointerW2(w1,w2:word32; var wInfoV:word32):pointer;
//==========================================================================
// given two word32, give the corresponding pointer and the associated info word32
// We accept an ambiguiy.
// We return a NIL pointer if no corresponding indexes (w1, w2)
// have been found in the table
var
  wIndex   : word32;
begin
// in most cases, this will be the key, but in case of collision,
// another key has to be choosen.
wIndex:=((w1 mod wTableSize) + (w2 mod wTableSize)) mod wTableSize;

repeat
    // usually repeat only once, but in case of collision, repeat more.
   if (pTable^[wIndex].wIndex1 = w1) and
      (pTable^[wIndex].wIndex2 = w2) then begin
      wInfoV:=pTable^[wIndex].wInfo;
      GetPointerW2:=pTable^[wIndex].pT;
      exit;
      end;

   // try with a next index.
   wIndex:=pTable^[wIndex].wIndexNext;
   until (wIndex = word32(-1));

// Index (w1, w2) not found in the table
wInfoV:=0;
GetPointerW2:=NIL;
end;  //  THashTableW2.GetPointerW2

end.  // unit wHashTable2;

