hash set + hash map 2

git-svn-id: trunk@17299 -

.gitattributes

@@ -2318,6 +2318,8 @@ packages/fcl-stl/doc/vector.tex svneol=native#text/plain
 packages/fcl-stl/doc/vectorexample.pp svneol=native#text/plain
 packages/fcl-stl/src/garrayutils.pp svneol=native#text/plain
 packages/fcl-stl/src/gdeque.pp svneol=native#text/plain
+packages/fcl-stl/src/ghashmap.pp svneol=native#text/plain
+packages/fcl-stl/src/ghashset.pp svneol=native#text/plain
 packages/fcl-stl/src/gmap.pp svneol=native#text/plain
 packages/fcl-stl/src/gpriorityqueue.pp svneol=native#text/plain
 packages/fcl-stl/src/gqueue.pp svneol=native#text/plain
@@ -2328,6 +2330,8 @@ packages/fcl-stl/src/gvector.pp svneol=native#text/plain
 packages/fcl-stl/tests/clean svneol=native#text/plain
 packages/fcl-stl/tests/garrayutilstest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gdequetest.pp svneol=native#text/plain
+packages/fcl-stl/tests/ghashmaptest.pp svneol=native#text/plain
+packages/fcl-stl/tests/ghashsettest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gmaptest.pp svneol=native#text/plain
 packages/fcl-stl/tests/gmaptestzal.pp svneol=native#text/plain
 packages/fcl-stl/tests/gpriorityqueuetest.pp svneol=native#text/plain

packages/fcl-stl/src/ghashmap.pp

@@ -0,0 +1,216 @@
+{
+   This file is part of the Free Pascal FCL library.
+   BSD parts (c) 2011 Vlado Boza
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit ghashmap;
+
+interface
+uses gvector, gutil, garrayutils;
+
+const baseFDataSize = 8;
+
+{Thash should have one class function hash(a:TKey, n:longint):longint which return uniformly distributed
+value in range <0,n-1> base only on arguments, n will be always power of 2}
+
+type
+  generic THashmapIterator<T, TTable>=class
+    public
+    var
+      Fh,Fp:SizeUInt;
+      FData:TTable;
+      function Next:boolean;
+      function GetValue:T;
+  end;
+
+  generic THashmap<TKey, TValue, Thash>=class
+    public
+    type
+      TPair=record
+        Value:TValue;
+        Key:TKey;
+      end;
+    var
+    private 
+    type
+      TContainer = specialize TVector<TPair>;
+      TTable = specialize TVector<TContainer>;
+    var 
+      FData:TTable;
+      FDataSize:SizeUInt; 
+      procedure EnlargeTable;
+    public 
+    type
+      TIterator = specialize THashmapIterator<TPair, TTable>;
+      constructor create;
+      destructor destroy;override;
+      procedure insert(key:TKey;value:TValue);inline;
+      function contains(key:TKey):boolean;inline;
+      function size:SizeUInt;inline;
+      procedure delete(key:TKey);inline;
+      function IsEmpty:boolean;inline;
+      function GetValue(key:TKey):TValue;inline;
+
+      property Items[i : TKey]: TValue read GetValue write Insert; default;
+
+      function Iterator:TIterator;
+  end;
+
+implementation
+
+function THashmap.Size:SizeUInt;inline;
+begin
+  Size:=FDataSize;
+end;
+
+destructor THashmap.Destroy;
+var i:SizeUInt;
+begin
+  for i:=0 to FData.size do
+    (FData[i]).Destroy;
+  FData.Destroy;
+end;
+
+function THashmap.IsEmpty():boolean;inline;
+begin
+  if Size()=0 then 
+    IsEmpty:=true
+  else 
+    IsEmpty:=false;
+end;
+
+procedure THashmap.EnlargeTable;
+var i,j,h,oldDataSize:SizeUInt; 
+    value:TPair;
+begin
+  oldDataSize:=FData.size;
+  FData.resize(FData.size*2);
+  for i:=oldDataSize to FData.size-1 do
+    FData[i] := TContainer.create;
+  for i:=oldDataSize-1 downto 0 do begin
+    j := 0;
+    while j < (FData[i]).size do begin
+      value := (FData[i])[j];
+      h:=Thash.hash(value.key,FData.size);
+      if (h <> i) then begin
+        (FData[i])[j] := (FData[i]).back;
+        (FData[i]).popback;
+        (FData[h]).pushback(value);
+      end else
+        inc(j);
+    end;
+  end;
+end;
+
+constructor THashmap.create;
+var i:longint;
+begin
+  FDataSize:=0;
+  FData:=TTable.create;
+  FData.resize(baseFDataSize);
+  for i:=0 to baseFDataSize-1 do
+    FData[i]:=TContainer.create;
+end;
+
+function THashmap.contains(key:TKey):boolean;inline;
+var i,h,bs:longint;
+begin
+  h:=Thash.hash(key,FData.size);
+  bs:=(FData[h]).size;
+  for i:=0 to bs-1 do begin
+    if (((FData[h])[i]).Key=key) then exit(true);
+  end;
+  exit(false);
+end;
+
+function THashmap.GetValue(key:TKey):TValue;inline;
+var i,h,bs:longint;
+begin
+  h:=Thash.hash(key,FData.size);
+  bs:=(FData[h]).size;
+  for i:=0 to bs-1 do begin
+    if (((FData[h])[i]).Key=key) then exit(((FData[h])[i]).Value);
+  end;
+end;
+
+procedure THashmap.insert(key:TKey;value:TValue);inline;
+var pair:TPair; i,h,bs:longint;
+begin
+  h:=Thash.hash(key,FData.size);
+  bs:=(FData[h]).size;
+  for i:=0 to bs-1 do begin
+    if (((FData[h])[i]).Key=key) then begin
+      ((FData[h]).mutable[i])^.value := value;
+      exit;
+    end;
+  end;
+  pair.Key := key;
+  pair.Value := value;
+  inc(FDataSize);
+  (FData[h]).pushback(pair);
+
+  if (FDataSize > 2*FData.size) then
+    EnlargeTable;
+end;
+
+procedure THashmap.delete(key:TKey);inline;
+var h,i:SizeUInt;
+begin
+  h:=Thash.hash(key,FData.size);
+  i:=0;
+  while i < (FData[h]).size do begin
+    if (((FData[h])[i]).key=key) then begin
+      (FData[h])[i] := (FData[h]).back;
+      (FData[h]).popback;
+      dec(FDataSize);
+      exit;
+    end;
+    inc(i);
+  end;
+end;
+
+function THashmapIterator.Next:boolean;
+begin
+  inc(Fp);
+  if (Fp = (FData[Fh]).size) then begin
+    Fp:=0; inc(Fh);
+    while Fh < FData.size do begin
+      if ((FData[Fh]).size > 0) then break;
+      inc(Fh);
+    end;
+    if (Fh = FData.size) then exit(false);
+  end;
+  Next := true;
+end;
+
+function THashmapIterator.GetValue:T;
+begin
+  GetValue:=(FData[Fh])[Fp];
+end;
+
+function THashmap.Iterator:TIterator;
+var h,p:SizeUInt;
+begin
+  h:=0;
+  p:=0;
+  while h < FData.size do begin
+    if ((FData[h]).size > 0) then break;
+    inc(h);
+  end;
+  if (h = FData.size) then exit(nil);
+  Iterator := TIterator.create;
+  Iterator.Fh := h;
+  Iterator.Fp := p;
+  Iterator.FData := FData;
+end;
+
+end.

packages/fcl-stl/src/ghashset.pp

@@ -0,0 +1,186 @@
+{
+   This file is part of the Free Pascal FCL library.
+   BSD parts (c) 2011 Vlado Boza
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit ghashset;
+
+interface
+uses gvector, gutil, garrayutils;
+
+const baseFDataSize = 8;
+
+{Thash should have one class function hash(a:T, n:longint):longint which return uniformly distributed
+value in range <0,n-1> base only on arguments, n will be always power of 2}
+
+type
+    generic THashSetIterator<T, TTable>=class
+    public
+    var
+      Fh,Fp:SizeUInt;
+      FData:TTable;
+      function Next:boolean;
+      function GetValue:T;
+  end;
+
+  generic THashSet<T, Thash>=class
+    private 
+    type 
+      TContainer = specialize TVector<T>;
+      TTable = specialize TVector<TContainer>;
+    var 
+      FData:TTable;
+      FDataSize:SizeUInt; 
+      procedure EnlargeTable;
+    public 
+    type
+      TIterator = specialize THashSetIterator<T, TTable>;
+      constructor create;
+      destructor destroy;override;
+      procedure insert(value:T);inline;
+      function contains(value:T):boolean;inline;
+      function size:SizeUInt;inline;
+      procedure delete(value:T);inline;
+      function IsEmpty:boolean;inline;
+
+      function Iterator:TIterator;
+  end;
+
+implementation
+
+function THashSet.Size:SizeUInt;inline;
+begin
+  Size:=FDataSize;
+end;
+
+destructor THashSet.Destroy;
+var i:SizeUInt;
+begin
+  for i:=0 to FData.size do
+    (FData[i]).Destroy;
+  FData.Destroy;
+end;
+
+function THashSet.IsEmpty():boolean;inline;
+begin
+  if Size()=0 then 
+    IsEmpty:=true
+  else 
+    IsEmpty:=false;
+end;
+
+procedure THashSet.EnlargeTable;
+var i,j,h,oldDataSize:SizeUInt; 
+    value:T;
+begin
+  oldDataSize:=FData.size;
+  FData.resize(FData.size*2);
+  for i:=oldDataSize to FData.size-1 do
+    FData[i] := TContainer.create;
+  for i:=oldDataSize-1 downto 0 do begin
+    j := 0;
+    while j < (FData[i]).size do begin
+      value := (FData[i])[j];
+      h:=Thash.hash(value,FData.size);
+      if (h <> i) then begin
+        (FData[i])[j] := (FData[i]).back;
+        (FData[i]).popback;
+        (FData[h]).pushback(value);
+      end else
+        inc(j);
+    end;
+  end;
+end;
+
+constructor THashSet.create;
+var i:longint;
+begin
+  FDataSize:=0;
+  FData:=TTable.create;
+  FData.resize(baseFDataSize);
+  for i:=0 to baseFDataSize-1 do
+    FData[i]:=TContainer.create;
+end;
+
+function THashSet.contains(value:T):boolean;inline;
+var i,h,bs:longint;
+begin
+  h:=Thash.hash(value,FData.size);
+  bs:=(FData[h]).size;
+  for i:=0 to bs-1 do begin
+    if ((FData[h])[i]=value) then exit(true);
+  end;
+  exit(false);
+end;
+
+procedure THashSet.insert(value:T);inline;
+begin
+  if (contains(value)) then exit;
+  inc(FDataSize);
+  (FData[Thash.hash(value,FData.size)]).pushback(value);
+
+  if (FDataSize > 2*FData.size) then
+    EnlargeTable;
+end;
+
+procedure THashSet.delete(value:T);inline;
+var h,i:SizeUInt;
+begin
+  h:=Thash.hash(value,FData.size);
+  i:=0;
+  while i < (FData[h]).size do begin
+    if ((FData[h])[i]=value) then begin
+      (FData[h])[i] := (FData[h]).back;
+      (FData[h]).popback;
+      dec(FDataSize);
+      exit;
+    end;
+    inc(i);
+  end;
+end;
+
+function THashSetIterator.Next:boolean;
+begin
+  inc(Fp);
+  if (Fp = (FData[Fh]).size) then begin
+    Fp:=0; inc(Fh);
+    while Fh < FData.size do begin
+      if ((FData[Fh]).size > 0) then break;
+      inc(Fh);
+    end;
+    if (Fh = FData.size) then exit(false);
+  end;
+  Next := true;
+end;
+
+function THashSetIterator.GetValue:T;
+begin
+  GetValue:=(FData[Fh])[Fp];
+end;
+
+function THashSet.Iterator:TIterator;
+var h,p:SizeUInt;
+begin
+  h:=0;
+  p:=0;
+  while h < FData.size do begin
+    if ((FData[h]).size > 0) then break;
+    inc(h);
+  end;
+  if (h = FData.size) then exit(nil);
+  Iterator := TIterator.create;
+  Iterator.Fh := h;
+  Iterator.Fp := p;
+  Iterator.FData := FData;
+end;
+
+end.

packages/fcl-stl/tests/ghashmaptest.pp

@@ -0,0 +1,99 @@
+{$mode objfpc}
+
+unit ghashmaptest;
+
+interface
+
+uses fpcunit, testregistry, ghashmap;
+
+type hint=class
+  class function hash(a,n:SizeUInt):SizeUInt;
+end;
+
+type THashmaplli=specialize THashMap<longint, longint, hint>;
+
+type TGHashmapTest = class(TTestCase)
+  Published
+    procedure HashmapTest1;
+    procedure HashmapTest2;
+    procedure HashmapTest3;
+  public
+    procedure Setup;override;
+  private 
+    data:THashmaplli;
+  end;
+
+implementation
+
+class function hint.hash(a,n:SizeUInt):SizeUInt;
+begin
+  hash:= (a xor (a shr 5) xor (a shl 7)) and (n-1);
+end;
+
+procedure TGHashmapTest.HashMapTest1;
+var i:longint;
+begin
+  AssertEquals('Not IsEmpty', true, data.IsEmpty);
+  data.insert(47, 42);
+  AssertEquals('47 not found', true, data.contains(47));
+  AssertEquals('39 found', false, data.contains(39));
+  data[39]:=33;
+  data[47]:=22;
+  AssertEquals('bad size', 2, data.size);
+  AssertEquals('bad 47', 22, data[47]);
+  for i:=0 to 10000 do
+    data[20*i+42] := 47+i;
+  for i:=0 to 10000 do
+    AssertEquals('bad number found', false, data.contains(i*5+101));
+  for i:=0 to 10000 do
+    AssertEquals('bad number', i+47, data[i*20+42]);
+  AssertEquals('IsEmpty', false, data.IsEmpty);
+end;
+
+procedure TGHashmapTest.HashMapTest2;
+var i:longint;
+begin
+  for i:=0 to 1000 do
+    data[3*i] := 7*i;
+  for i:=0 to 1000 do
+    data.delete(3*i+1);
+  AssertEquals('bad size before delete', 1001, data.size);
+  for i:=500 to 1000 do
+    data.delete(3*i);
+  AssertEquals('bad size after delete', 500, data.size);
+  for i:=0 to 499 do
+    AssertEquals('element not found', true, data.contains(3*i));
+  for i:=500 to 1000 do
+    AssertEquals('deleted element found', false, data.contains(3*i));
+end;
+
+procedure TGHashmapTest.HashMapTest3;
+var i:longint;
+    x:array[0..1000] of longint;
+    it:THashmaplli.TIterator;
+begin
+  it:=data.Iterator;
+  if it <> nil then
+    AssertEquals('it not null', 0, 1);
+  for i:=0 to 1000 do begin
+    data[i]:=47*i;
+    x[i]:=0;
+  end;
+  it:=data.Iterator;
+  repeat
+    inc(x[it.GetValue.key]);
+    AssertEquals('bad value', it.GetValue.key*47, it.GetValue.value);
+  until not it.next;
+  for i:=0 to 1000 do begin
+    AssertEquals('som not 1', 1, x[i]);
+  end;
+end;
+
+procedure TGHashmapTest.Setup;
+begin
+  data:=THashmaplli.create;
+end;
+
+initialization
+  RegisterTest(TGHashmapTest);
+end.

packages/fcl-stl/tests/ghashsettest.pp

@@ -0,0 +1,97 @@
+{$mode objfpc}
+
+unit ghashsettest;
+
+interface
+
+uses fpcunit, testregistry, ghashset;
+
+type hint=class
+  class function hash(a,n:SizeUInt):SizeUInt;
+end;
+
+type THashsetlli=specialize THashSet<longint, hint>;
+
+type TGHashSetTest = class(TTestCase)
+  Published
+    procedure HashSetTest1;
+    procedure HashSetTest2;
+    procedure HashSetTest3;
+  public
+    procedure Setup;override;
+  private 
+    data:THashsetlli;
+  end;
+
+implementation
+
+class function hint.hash(a,n:SizeUInt):SizeUInt;
+begin
+  hash:= (a xor (a shr 5) xor (a shl 7)) and (n-1);
+end;
+
+procedure TGHashSetTest.HashSetTest1;
+var i:longint;
+begin
+  AssertEquals('Not IsEmpty', true, data.IsEmpty);
+  data.insert(47);
+  AssertEquals('47 not found', true, data.contains(47));
+  AssertEquals('39 found', false, data.contains(39));
+  data.insert(39);
+  data.insert(47);
+  AssertEquals('bad size', 2, data.size);
+  for i:=0 to 10000 do
+    data.insert(20*i+42);
+  for i:=0 to 10000 do
+    AssertEquals('bad number found', false, data.contains(i*5+101));
+  for i:=0 to 10000 do
+    AssertEquals('number not found', true, data.contains(i*20+42));
+  AssertEquals('IsEmpty', false, data.IsEmpty);
+end;
+
+procedure TGHashSetTest.HashSetTest2;
+var i:longint;
+begin
+  for i:=0 to 1000 do
+    data.insert(3*i);
+  for i:=0 to 1000 do
+    data.delete(3*i+1);
+  AssertEquals('bad size before delete', 1001, data.size);
+  for i:=500 to 1000 do
+    data.delete(3*i);
+  AssertEquals('bad size after delete', 500, data.size);
+  for i:=0 to 499 do
+    AssertEquals('element not found', true, data.contains(3*i));
+  for i:=500 to 1000 do
+    AssertEquals('deleted element found', false, data.contains(3*i));
+end;
+
+procedure TGHashSetTest.HashSetTest3;
+var i:longint;
+    x:array[0..1000] of longint;
+    it:THashSetlli.TIterator;
+begin
+  it:=data.Iterator;
+  if it <> nil then
+    AssertEquals('it not null', 0, 1);
+  for i:=0 to 1000 do begin
+    data.insert(i);
+    x[i]:=0;
+  end;
+  it:=data.Iterator;
+  repeat
+    inc(x[it.GetValue]);
+  until not it.next;
+  for i:=0 to 1000 do begin
+    AssertEquals('som not 1', 1, x[i]);
+  end;
+end;
+
+procedure TGHashSetTest.Setup;
+begin
+  data:=THashSetlli.create;
+end;
+
+initialization
+  RegisterTest(TGHashSetTest);
+end.