hash.pas

解码器是基于短语的统计机器翻译系统的核心模块

(*
* HASH.PAS  -  A simple hash table
*
* Copyright (C) 2006 by Yidong Chen <[e-mail]>
Institute of Artificial Intelligence, Xiamen University

* Begin       : 09/18/2006
* Last Change : 09/18/2006
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
* 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.  See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
*)

UNIT HASH;

INTERFACE

USES SysUtils, Classes;

CONST
  POS_NOTDEF=-2;
  POS_OUTOFSIZE=-1;
  POS_USELESS=-3;

  HASH_OK=0;
  EHASH_KEYEXISTS=-1;
  EHASH_OUTOFSIZE=-2;
  EHASH_KEYNOTFND=-3;

TYPE
  TFreeEntry=PROCEDURE(Value: Pointer);
  TDoPerEntry=PROCEDURE(Key: STRING; Value: Pointer);
  TDoPerEntryObject=PROCEDURE(Key: STRING; Value: Pointer) OF OBJECT;
  TDoPerEntryNoKey=PROCEDURE(Value: Pointer);
  TDoPerEntryNoKeyObject=PROCEDURE(Value: Pointer) OF OBJECT;
  TDoPerEntryReturn=FUNCTION(Key: STRING; Value: Pointer): Boolean;

  THash=CLASS
  PRIVATE
    HashBits: Integer;
    FRecCount: Integer;
    lstTable: TList;
    FfeAction: TFreeEntry;
    FUNCTION HashFunction(Key: STRING): Integer;
    FUNCTION Hash(Key: STRING): Integer;
    FUNCTION HashSize: Integer;
    FUNCTION GrowSize: Boolean;
    PROCEDURE Clear;
  PUBLIC
    PROPERTY Table: TList READ lstTable;
    PROPERTY RecCount: Integer READ FRecCount;
    CONSTRUCTOR Create(Size: Integer; feAction: TFreeEntry);
    FUNCTION Insert(Key: STRING; Value: Pointer; iPos: Integer=POS_NOTDEF): Integer;
    FUNCTION Search(Key: STRING; VAR Value: Pointer; VAR iPos: Integer): Integer; OVERLOAD;
    FUNCTION Search(Key: STRING; VAR Value: Pointer): Integer; OVERLOAD;

    PROCEDURE SetValue(iPos: Integer; Value: Pointer);

    FUNCTION DoEach(Key: STRING; dpeAction: TDoPerEntry): Integer; OVERLOAD;
    FUNCTION DoEach(Key: STRING; dpeoAction: TDoPerEntryObject): Integer; OVERLOAD;
    FUNCTION DoEach(Key: STRING; dpenkAction: TDoPerEntryNoKey): Integer; OVERLOAD;
    FUNCTION DoEach(Key: STRING; dpenkoAction: TDoPerEntryNoKeyObject): Integer; OVERLOAD;
    PROCEDURE DoEach(dpeAction: TDoPerEntry); OVERLOAD;
    PROCEDURE DoEach(dpeoAction: TDoPerEntryObject); OVERLOAD;
    PROCEDURE DoEach(dpenkAction: TDoPerEntryNoKey); OVERLOAD;
    PROCEDURE DoEach(dpenkoAction: TDoPerEntryNoKeyObject); OVERLOAD;

    PROCEDURE GetAllContents(lstTarget: TList);

    //useing ClearNil and Sort will damage the hash table, use carefully.
    PROCEDURE ClearNil;
    PROCEDURE Sort(lscAction: TListSortCompare); OVERLOAD;
    PROCEDURE Sort; OVERLOAD;
    DESTRUCTOR Destroy; OVERRIDE;
  END;

//the following functions are used when the user would like to operate the Table of a hash table
//directly.
FUNCTION GetKey(lstTable: TList; iIndex: Integer): STRING;
PROCEDURE GetKeyAndInfo(lstTable: TList; iIndex: Integer; VAR Key: STRING; VAR Value: Pointer);
PROCEDURE SortTable(lstTable: TList; lscAction: TListSortCompare);
PROCEDURE DoEach(lstTable: TList; dpeAction: TDoPerEntry); OVERLOAD;
PROCEDURE DoEach(lstTable: TList; dperAction: TDoPerEntryReturn; iMaxCount: Integer=-1); OVERLOAD;

IMPLEMENTATION

CONST
  HASHBITS_INIT=3;
  HASHBITS_MAX=32;
  RATIO=0.75;

TYPE
  TPHashRec=^THashRec;
  THashRec=RECORD
    Key: STRING;
    Value: Pointer;
  END;

FUNCTION THash.HashFunction(Key: STRING): Integer;
var
  I: Integer;
BEGIN
  Result := 1048583;

  for I := 1 to Length(Key) do
    Result := (Result shl 5) - Result + Ord(Key[I]);

  Result:=(Result and $7fffffff);
END;

(*
//ELFHash
FUNCTION THash.HashFunction(Key: STRING): Integer;
Var
 I: LongInt;
 x: LongInt;
Begin
  Result := 0;
  For I := 1 to Length(Key) do
   Begin
    Result := (Result Shl 4)+Ord(Key[i]);
    x := Result And $F0000000;
    If (x <> 0) then
     Begin
      Result := Result Xor (x Shr 24);
      Result := Result And (Not x);
     End;
   End;
END;
*)

(*
//PJWHash
Function THash.HashFunction(Key:String):Longint;
Const
  BitsInLongint = Sizeof(longint) * 8;
  ThreeQuarters = (BitsInLongint  * 3) Div 4;
  OneEighth     = BitsInLongint Div 8;
  HighBits      : Longint = (not Longint(0)) Shl (BitsInLongint - OneEighth);
Var
 I    :Longint;
 Test :Longint;
Begin
 Result := 0;
 For I := 1 to Length(Key) do
  Begin
   Result := (Result shl OneEighth) + ord(Key[i]);
   Test := Result and HighBits;
   If (Test <> 0) then
    Begin
     Result := (Result Xor (Test Shr ThreeQuarters)) And Not HighBits;
    End;
  End;
End;
*)

(*
//BKDRHash
Function THash.HashFunction(Key:String):Longint;
Var
 I : LongInt;
Begin
 Result := 0;
 For I := 1 to Length(Key) do
  Begin
   Result := (Result*31)+Ord(Key[i]);
  End;
End;
*)

(*
//BKDR2Hash
Function THash.HashFunction(Key:String):Longint;
Var
 I : LongInt;
Begin
 Result := 0;
 For I := 1 to length(Key) do
  Begin
   Result := (Result*131)+Ord(Key[i]);
  End;
End;
*)

FUNCTION THash.HashSize: Integer;
BEGIN
  Result := 1 SHL HashBits;
END;

FUNCTION THash.Hash(Key: STRING): Integer;
VAR Count: Integer;
BEGIN
  Count:=HashSize;
  Result:=HashFunction(Key) AND (Count - 1)
END;

FUNCTION THash.GrowSize: Boolean;

  //InnerInsert should always be invoked after the growth of the hash talbe or the compact of the hash
  PROCEDURE InnerInsert(Key: STRING; phrNode: TPHashRec);
  VAR iLooper, iIndex, Count: Integer; phrTemp: TPHashRec;
  BEGIN
    Count:=HashSize;

    iIndex:=Hash(Key);
    IF lstTable.Items[iIndex]<>NIL THEN
      BEGIN
        iLooper:=iIndex+1;
        IF iLooper>=Count THEN iLooper:=0;
        WHILE iLooper<>iIndex DO
          BEGIN
            phrTemp:=lstTable.Items[iLooper];
            IF phrTemp=NIL THEN Break;
            Inc(iLooper);
            IF iLooper>=Count THEN iLooper:=0;
          END;
        lstTable.Items[iLooper]:=phrNode;
      END
    ELSE lstTable.Items[iIndex]:=phrNode;

    Inc(FRecCount);
  END;

VAR lstOldTable: TList; iLooper, iOldCount, Count: Integer;
    phrTemp: TPHashRec;
BEGIN
  Result:=False;

  IF HashBits=HASHBITS_MAX THEN Exit;

  Inc(HashBits);

  FRecCount := 0;

  lstOldTable:=lstTable;

  lstTable:=TList.Create;

  Count:=HashSize;
  lstTable.Count:=Count;

  iOldCount:=lstOldTable.Count-1;
  FOR iLooper:=0 TO iOldCount DO
    BEGIN
      phrTemp:=lstOldTable.Items[iLooper];
      IF phrTemp<>NIL THEN InnerInsert(phrTemp.Key, phrTemp);
    END;

  lstOldTable.Clear; lstOldTable.Free;

  Result:=True;
END;

PROCEDURE THash.Clear;
VAR iLooper, Count: Integer; phrTemp: TPHashRec;
BEGIN
  Count:=lstTable.Count-1;
  FOR iLooper:=0 TO Count DO
    BEGIN
      phrTemp:=lstTable.Items[iLooper];
      IF phrTemp<>NIL THEN
        BEGIN
          IF @FfeAction<>NIL THEN FfeAction(phrTemp.Value);
          Dispose(phrTemp);
        END;
    END;
  lstTable.Clear;
END;

PROCEDURE THash.GetAllContents(lstTarget: TList);
VAR iLooper, Count: Integer; phrTemp: TPHashRec;
BEGIN
  IF lstTarget=NIL THEN Exit;
  lstTarget.Clear;
  Count:=lstTable.Count-1;
  lstTarget.Capacity:=Count+1;
  FOR iLooper:=0 TO Count DO
    BEGIN
      phrTemp:=lstTable.Items[iLooper];
      IF phrTemp<>NIL THEN lstTarget.Add(phrTemp.Value);
    END;
  lstTarget.Capacity:=lstTarget.Count;
END;

CONSTRUCTOR THash.Create(Size: Integer; feAction: TFreeEntry);
VAR Count: Integer;
BEGIN
  INHERITED Create;
  lstTable:=TList.Create;
  FfeAction:=feAction;
  HashBits := HASHBITS_INIT;
  FRecCount := 0;
  WHILE HashSize < Size DO Inc(HashBits);

  Count:=HashSize;
  lstTable.Count:=Count;
END;

VAR lscUSERAction: TListSortCompare;

//Function HashCompare is used by Sort method and SortTable.
//The function will invoke lscUSERAction, so this globe variable should be set beforehand.
FUNCTION HashCompare(Item1, Item2: Pointer): Integer;
VAR phrTemp1, phrTemp2: TPHashRec;
BEGIN
  phrTemp1:=Item1; phrTemp2:=Item2;
  IF (phrTemp1=NIL) AND (phrTemp2=NIL) THEN Result:=0
  ELSE IF (phrTemp1=NIL) THEN Result:=1
  ELSE IF (phrTemp2=NIL) THEN Result:=-1
  ELSE Result:=lscUSERAction(phrTemp1.Value, phrTemp2.Value);
END;

FUNCTION HashCompareKey(Item1, Item2: Pointer): Integer;
VAR phrTemp1, phrTemp2: TPHashRec;
BEGIN
  phrTemp1:=Item1; phrTemp2:=Item2;
  IF (phrTemp1=NIL) AND (phrTemp2=NIL) THEN Result:=0
  ELSE IF (phrTemp1=NIL) THEN Result:=1
  ELSE IF (phrTemp2=NIL) THEN Result:=-1
  ELSE IF phrTemp1.Key>phrTemp2.Key THEN Result:=1
  ELSE IF phrTemp1.Key<phrTemp2.Key THEN Result:=-1
  ELSE Result:=0;
END;

FUNCTION GetKey(lstTable: TList; iIndex: Integer): STRING;
VAR phrTemp: TPHashRec;
BEGIN
  phrTemp:=lstTable.Items[iIndex];
  IF phrTemp=NIL THEN Result:='' ELSE Result:=phrTemp.Key;
END;

PROCEDURE GetKeyAndInfo(lstTable: TList; iIndex: Integer; VAR Key: STRING; VAR Value: Pointer);
VAR phrTemp: TPHashRec;
BEGIN
  phrTemp:=lstTable.Items[iIndex];
  IF phrTemp=NIL THEN
    BEGIN
      Key:='';
      Value:=NIL;
    END
  ELSE
    BEGIN
      Key:=phrTemp.Key;
      Value:=phrTemp.Value;
    END;
END;

PROCEDURE SortTable(lstTable: TList; lscAction: TListSortCompare);
BEGIN
  lscUSERAction:=lscAction;
  lstTable.Sort(@HashCompare);
END;

PROCEDURE DoEach(lstTable: TList; dpeAction: TDoPerEntry);
VAR iLooper, Count: Integer; phrTemp: TPHashRec;
BEGIN
  Count:=lstTable.Count-1;
  FOR iLooper:=0 TO Count DO
    BEGIN
      phrTemp:=lstTable.Items[iLooper];
      IF phrTemp<>NIL THEN dpeAction(phrTemp.Key, phrTemp.Value);
    END;
END;

PROCEDURE DoEach(lstTable: TList; dperAction: TDoPerEntryReturn; iMaxCount: Integer=-1);
VAR iLooper, Count, iCounter: Integer; phrTemp: TPHashRec;
BEGIN
  Count:=lstTable.Count-1;
  iCounter:=0;
  FOR iLooper:=0 TO Count DO
    BEGIN
      Inc(iCounter);
      IF (iMaxCount<>-1) AND (iCounter>iMaxCount) THEN Break;
      phrTemp:=lstTable.Items[iLooper];
      IF phrTemp<>NIL THEN
        IF NOT dperAction(phrTemp.Key, phrTemp.Value) THEN Break;
    END;
END;

PROCEDURE THash.ClearNil;
VAR iLooper: Integer; phrTemp: TPHashRec;
BEGIN
  FOR iLooper:=lstTable.Count-1 DOWNTO 0 DO
    BEGIN
      phrTemp:=lstTable.Items[iLooper];
      IF phrTemp=NIL THEN lstTable.Delete(iLooper);
    END;