home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / KRUSE_11.ZIP / ADDHASH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-01  |  3.2 KB  |  109 lines
  1. program MergeHashFiles(HashFile, NewHashFile, input, output);
  2.  
  3. const
  4.   maxwd    = 20;
  5.   hashsize = 2003;
  6.   blank    = ' ';
  7.  
  8. type
  9.   word      = packed array[1..maxwd] of char;
  10.   reference = record
  11.                 wd: word;
  12.                 pg: integer
  13.               end;
  14.   hashentry = 1..hashsize;
  15.  
  16. var
  17.   HashFile,
  18.   NewHashFile:           text;
  19.   blankword:             word;
  20.   i:  integer;
  21.  
  22. procedure UpdateHashFile;
  23. {reads in old hash table, inserts file of new entries; writes out to HashFile}
  24. {Updated version, uses hash tables of reference (not word) and hash files of
  25.  type text (not word).}
  26. var
  27.   hash:  array[hashentry] of reference;
  28.   x:     hashentry;
  29.   NewFile,
  30.   w:     word;
  31.  
  32.   function HashAddress(w: word): hashentry;
  33.   {calculates the location in hash table of word w, or, if not there,
  34.    returns pointing to the blank word where w should go}
  35.  
  36.   var
  37.     x,                            {calculated location}
  38.     inc:     integer;             {increment for open addressing}
  39.   begin                           {function HashAddress}
  40.     x := abs(ord(w[1])*ord(w[2])+ord(w[4])+ord(w[6])) mod hashsize + 1;
  41. {Hash function assumes long word length. For short word machines
  42.  we must ensure that the result is non-negative, and worry about overflow.}
  43.  
  44.     if (hash[x].wd <> w) and (hash[x].wd <> blankword) then
  45.       begin
  46.         inc   := (abs(ord(w[3])-95) mod 29);
  47.                   {A key dependent increment is used to avoid clustering.}
  48.         repeat
  49.           inc := inc + 1;
  50.           if inc > hashsize then
  51.             writeln(w,' causes hash table to become full, infinite loop.');
  52.           x := x + inc;
  53.           if x > hashsize then x := x - hashsize;
  54.         until (w =  hash[x].wd)  or  (blankword = hash[x].wd)
  55.       end;
  56.     HashAddress := x
  57.   end;                            {function HashAddress}
  58.  
  59.  
  60. begin                               {procedure UpdateHashFile}
  61.   reset(HashFile);
  62.   if eof(HashFile) then         {Error handler}
  63.     for x := 1 to hashsize do   {HashFile is empty; create new table.}
  64.       begin
  65.         hash[x].wd := blankword;
  66.         hash[x].pg := 0
  67.       end
  68.   else
  69.     for x := 1 to hashsize do
  70.       begin
  71.         read(HashFile, hash[x].pg);
  72.         while (HashFile^ = ' ') and not eoln(HashFile) do
  73.           get(HashFile);
  74.         readln(HashFile, hash[x].wd)
  75.       end;
  76.  
  77.   reset(NewHashFile);
  78.   while not eof(NewHashFile) do
  79.   begin
  80.     readln(NewHashFile, w);
  81.     hash[HashAddress(w)].wd := w
  82. {An identical hash function as used in phase 1 will be used.
  83.  Overflow is a possibility.}
  84.   end;
  85.  
  86.   close(HashFile);
  87. { In some system it may be necessary to close file HashFile at this point.}
  88.  
  89.   write('File name for updated hashfile?');
  90.   readln(NewFile);
  91.   open(HashFile, NewFile, new);
  92.   rewrite(HashFile);
  93.  
  94.   for x := 1 to hashsize do
  95.     with hash[x] do
  96.     begin
  97.       write(HashFile, pg:4, ' ');
  98.       if wd <> blankword then
  99.         write(HashFile, wd);
  100.       writeln(HashFile)
  101.     end
  102. end;                                {procedure UpdateHashFile}
  103.  
  104. begin                    {main program MergeHashFiles}
  105.   for i := 1 to maxwd do
  106.     blankword[i] := blank;
  107.   UpdateHashFile;
  108. end.                     {main program MergeHashFiles}
  109.