home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SEBHASH.ZIP / HASH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-10-05  |  3.2 KB  |  121 lines
  1. { Written in TP 3.0 -- Converted to TP 5.5 08-24-89 }
  2. { Modified 10/4/91, due to notice of inconsistency and incorrectness }
  3.  
  4. {$R-}    {Range checking off}
  5. {$B+}    {Boolean complete evaluation on}
  6. {$S+}    {Stack checking on}
  7. {$I+}    {I/O checking on}
  8.  
  9. Program SebestaHASH;
  10.  
  11. { HASHING, as was described by Sebesta's Technique (1986) but modified
  12.  
  13.    The function looks like this...
  14.  
  15. H(key) = L + g(key[1]) + g(key[L] + Alphabetic(key[L-1])
  16.  
  17.    Where L is the length of the given key. g(key[x]) is the
  18.  specific character's integer (ordinal) value and that
  19.  Alphabetic(key[L-1]) is the numerical alphabetic position of
  20.  the second to last charachter (1-26). Thus, "EXIT" would produce
  21.  H("EXIT") = 4 + g("E") + g("T") + 8 = 165
  22.  
  23. }
  24.  
  25.  
  26.  
  27. CONST
  28.   ArraySize = 71;     { Note, this is a prime number and should be a prime }
  29.  
  30. TYPE
  31.   StrType = STRING[80]; { Max 80 chars per line.  You can change this }
  32.   RecType = RECORD
  33.     Occupied : BOOLEAN;
  34.     Name : StrType;
  35.   END;
  36.   ArrayType = Array [1..ArraySize] of RecType;
  37.  
  38. VAR
  39.  InString : StrType;
  40.  Table : ArrayType;
  41.  I,J,NumSt,Collisions : Integer;
  42.  Occp : Integer;
  43.  
  44. Function Hash(S : StrType) : INTEGER;
  45.  Var
  46.   L,Temp : INTEGER;
  47.  
  48.   Function Alpha(Ch : CHAR) : INTEGER;
  49.    Var
  50.      Uch : char;
  51.    begin
  52.      Uch := UpCase(Ch);
  53.      If ((Uch >= 'A') and (Uch <= 'Z'))
  54.        then Alpha := (Ord(Uch) - 64) { not 65, 'A' - 64 = 1 }
  55.        else Alpha := Ord(Uch); { Any other ascii char gives its ascii code }
  56.    end;
  57.  
  58.  BEGIN
  59.    Temp := 0;
  60.    L := Length(S); { Get the Length of thing }
  61.    Temp := L + Ord(S[1]) + Ord(S[L]) + Alpha(S[L-1]);
  62.    Temp := (Temp MOD ArraySize) + 1;
  63.    Hash := Temp;
  64.  END;
  65.  
  66.  
  67. BEGIN { Main }
  68.   Collisions := 0;
  69.   For I := 1 to ArraySize do
  70.     Begin
  71.       Table[I].Occupied := FALSE;
  72.       Table[I].Name := '';
  73.     End;
  74.   Write('How Many Strings of chars will be inputted ? ');
  75.   ReadLn(NumSt);
  76.   For I := 1 to NumSt do
  77.     Begin
  78.       Write ('String Number ',I:4,' ? ');
  79.       ReadLn(InString);
  80.       WriteLn;
  81.       J := Hash(Instring);
  82.       IF Table[J].Occupied
  83.          THEN
  84.            Begin
  85.              WriteLn('**** Collision at J=',J,' ',Instring,' and ',Table[J].Name);
  86.              Collisions := Succ(Collisions);
  87.            End
  88.          ELSE
  89.            Begin
  90.              Table[J].Occupied := TRUE;
  91.              Table[J].Name := Instring;
  92.            End;
  93.     End;
  94.   WriteLN;
  95.   Occp := 0;
  96.   For I := 1 to ArraySize do
  97.     If Table[I].Occupied then
  98.       begin
  99.         WriteLn('Position ',I,' STRING = "',Table[I].Name,'"');
  100.         Occp := Succ(Occp);
  101.       end;
  102.   WriteLn;
  103.   WriteLn('STATISTICS:::');
  104.   WriteLn(Collisions,' total string allocation hash collisions.');
  105.   Write('(', Occp,' of ',ArraySize,' array spaces occupied) ');
  106.   WriteLn(((Occp/ArraySize)*100):3:3,'% utilization.');
  107.   Write('(', Occp,' of ',NumSt,' input strings allocated) ');
  108.   WriteLn(((Occp/NumSt)*100):3:3,'% utilization.');
  109.   WriteLn;
  110.   WriteLn('Inverted Cluster Map');
  111.   For I := 1 to ArraySize do
  112.     Write((I mod 10):1);
  113.   WriteLn;
  114.   For I := 1 to ArraySize do
  115.     If Table[I].Occupied
  116.       then write(chr(219))
  117.       else write(' ');
  118.   WriteLn;
  119.   WriteLn('End Run.');
  120. END.
  121.