{------------------------------------- ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- You May Not Use This File Except in Compliance with Thelicense. You may Obtain a Copy of The License Athttp://www.mozilla.org/npl/npl-1_1final.html
Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License forthe specific language governing rights and limitations under the License.
The Original Code Is: MWStringHashlist.Pas, Released Decemrr 18, 2000.
The Initial Developer of The Original Code Is Martin Waldenburg (Martin.waldenburg@t-online.de). Previouss created by Martin Waldenburg Are Copyright (C) 2000 Martin Waldenburg.all Rights Reserved.
Contributor (s): ___________________.
Last Modified: 18/12 / 2000Current Version: 1.1
Notes: this is a very fast hash list for strings. The Tinyhash Functions Should Be in Most Cases Suffizient
KNOWN ISSUES: ----------------------------------- ------------------------------}
Unit mwstringhashlist;
Interface
Uses classes, sysutils;
Var mwhashtable: array [# 0 .. # 255] of byte; mwinsensitivehashtable: array [# 0 .. # 255] of byte;
TYPE TMWSTRINGHASH = Function (const astring: string): Integer; tmwstringHashCompare = function (const str1: string; const str2: string): boolean;
TMWHASHWORD = Class S: String; Constructor Create (Astring: String);
PhashPointerlist = ^ ThashPointerList; ThashPointerlist = array [1..1] of pointer;
TmwBaseStringHashList = class (TObject) FList: PHashPointerList; fCapacity: Integer; protected function Get (Index: Integer): Pointer; procedure Put (Index: Integer; Item: Pointer); procedure SetCapacity (NewCapacity: Integer); public destructor Destroy; override ; property Capacity: Integer read fCapacity; property Items [Index: Integer]: Pointer read Get write Put; default; end; TmwHashStrings = class (TList) public destructor Destroy; override; procedure AddString (S: String); end;
TMWHASHITEMS = Class (TMWBaseStringHashlist) Public Procedure AddString (S: String);
TmwStringHashList = class (TmwBaseStringHashList) private fHash: TmwStringHash; fCompare: TmwStringHashCompare; public constructor Create (aHash: TmwStringHash; aCompare: TmwStringHashCompare); procedure AddString (S: String); function Hash (S: String): Boolean; function HashEX (S : String; HashValue: Integer: Boolean; End;
function SimpleHash (const aString: String): Integer; function ISimpleHash (const aString: String): Integer; function TinyHash (const aString: String): Integer; function ITinyHash (const aString: String): Integer; function HashCompare (const Str1: String; const str2: string: boolean; function ihashcompare (const str2: string): boolean;
IMPLEMentation
Procedure inittables; var i: char; begin for i: = # 0 to # 255 do begin mwhashtable [i]: = ORD (i); mwinsensitiveHashtable [i]: = ORD (Uppercase (String (i)) [1]) ; End;
Function Simple Hash: Integer; Var i: Integer; Begin Result: = Length (Astring); for i: = 1 to length (assenging) do inc (Result, mwhashtable [astring [i]]); end ;
Function isimpleHash: Integer; var i: integer; begin result: = length (asse "; for i: = 1 to length (assenging) do inc (Result, mwinsensitiveHashtable [astring [i]]); END Function tinyhash (const astring: integer; begin result: = length (assenging); for i: = 1 to length (assenging) do begin inc (Result, mwhashtable [astring [i]]) ; If i = 2 dam; End;
Function Itinyhash (constra i: integer; begin result: = length (astring); for i: = 1 to length (assenging) do begin inc (Result, mwinsensitiveHashtable [Astring [i]]); IF i = 2 dam; end;
Function hashcompare (const str2: string): boolean; var i: integer; begin if length (str1) <> length (str2) THEN BEGIN Result: = false; exit; end; result: = true; I: = 1 to Length (str1) do if str1 [i] <> str2 [i] the begin result: = false;
Function ihashcompare (const str2: string): boolean; var i: integer; begin if longth (str1) <> length (str2) THEN BEGIN Result: = false; exit; end; result: = true; for I: = 1 to Length (str1) do if mwinsensitiveHashtable [str1 [i]] <> mwinsensitiveHashtable [str2 [i]] dam result: = false;
{TMWHASHSTRING}
CONSTRUCTOR TMWHASHWORD.CREATE (Astring: string); begin inherited create; s: = astring;
{TMWBaseStringHashlist}
Destructor TMWBaseStringHashlist.Destroy; Var i: integer; begin for i: = 1 to fcapacity do if items [i] <> nil damject (items [i]). free; reallocmem (flist, 0); inherited destroy;
function TmwBaseStringHashList.Get (Index: Integer): Pointer; begin Result: = nil; if (Index> 0) and (Index <= fCapacity) then Result: = fList [Index]; end; procedure TmwBaseStringHashList.Put (Index: Integer Item: Pointer; Begin IF (INDEX> 0) THEN FLIST [INDEX]: = Item; END;
procedure TmwBaseStringHashList.SetCapacity (NewCapacity: Integer); var I, OldCapacity: Integer; begin if NewCapacity> fCapacity then begin ReallocMem (FList, (NewCapacity) * SizeOf (Pointer)); OldCapacity: = fCapacity; FCapacity: = NewCapacity; for I : = Oldcapacity 1 to newcapacity do items [i]: = nil; end;
{TMWHASHSTRINGS}
Procedure tmwhashstrings.addstring (s: string); begin add (tmwhashword.create (s));
DESTRUCTOR TMWHASTRINGS.DESTROY; VAR i: Integer; Begin for i: = 0 to count - 1 do if items [i] <> nil damject (items [i]). free; inherited destroy;
{TMWHASHITEMS}
procedure TmwHashItems.AddString (S: String); var HashWord: TmwHashWord; HashStrings: TmwHashStrings; begin SetCapacity (Length (S)); if Items [Length (S)] = nil then begin Items [Length (S)]: = TmwHashWord .Create (s); Else if Tobject (items [length (s)]) is TMWHASTRINGS THEN BEGIN TMWHASTRINGS (Items [Length (s)]). Addstring (s); end else begin hashword: = Items [Length )]; Hashstrings: = tmwhashstrings.create; items [length (s)]: = hashstrings; hashstrings.addstring (hashword.s); hashword.free; hashstrings.addstring (s) end; end;
{TMWSTRINGHASHLIST}
Sign In CONSTRUCTOR TMWSTRINGHASHLIST.CREATE (AHASH: TMWSTRINGHASH; ACOMPARE: TMWSTRINGHASHCompare; begin inherited create; fhash: = ahash; fcompare: = ACOMPARE;
procedure TmwStringHashList.AddString (S: String); var HashWord: TmwHashWord; HashValue: Integer; HashItems: TmwHashItems; begin HashValue: = fHash (S); if HashEx (S, HashValue) then exit; if HashValue> = fCapacity then SetCapacity ( HashValue); if Items [HashValue] = nil then begin Items [HashValue]:. = TmwHashWord.Create (S); end else if TObject (Items [HashValue]) is TmwHashItems then begin TmwHashItems (Items [HashValue]) AddString (S ); end else begin HashWord: = Items [HashValue]; HashItems: = TmwHashItems.Create; Items [HashValue]: = HashItems; HashItems.AddString (HashWord.S); HashWord.Free; HashItems.AddString (S); end; End; function tmwstringhashlist.hash (s: string): Boolean; Begin Result: = Hashex (S, Fhash (s));
function TmwStringHashList.HashEX (S: String; HashValue: Integer): Boolean; var Temp: TObject; Hashword: TmwHashWord; HashItems: TmwHashItems; I: Integer; begin Result: = False; if HashValue <1 then Exit; if HashValue> Capacity then Exit; if Items [HashValue] <> nil then begin if TObject (Items [HashValue]) is TmwHashWord then begin Result: = fCompare (TmwHashWord (Items [HashValue]) S, S.); end else begin HashItems: = Items [HashValue]; if Length (s)> hashitems.capacity kiln exit; temp: = hashitems [length (s)]; if Temp <> nil dam result: = fcompare (Tempare (Temp) .s. S. , S); END ELSE for i: = 0 to TMWHASTRINGS (TEMP) .count -1 do begin hashword: = tmwhashstrings (temp) [i]; result: = fcompare (hashword.s, s); if Result dam End; end;
Initializationinittables; end.
