Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/HASH.ZIP/HASH.PAS

Pascal/Delphi Source File | 1985-12-28 | 13.9 KB | 498 lines

program address (input, output, infile, outfile);
const
   DASH          = 45;
   MAXNAME       = 25;
   MAXNUMBER     = 13;
   ENDFILE       = -1;
   ENDSTR        =  0;
   NEWLINE       = 10;
   PRIME_MODULUS = 47;
   MAXBUCKETS    = 50;
   MAXLINELENGTH = 80;

type
   character = -1..127;             { NOTE! NOT type "char" }
   name_type = array[1..MAXNAME] of character;
   phonenumbertype = array[1..MAXNUMBER] of character;
   info = record
      name        : name_type;
      phonenumber : phonenumbertype;
      end;
   ptr = ^node;
   node = record                     { typical node in d.s. }
      person : info;                 { entry for a person   }
      next   : ptr;                  { link to next entry   }
      end;

var
   BUCKET :   array[1..MAXBUCKETS] of ptr;  { linked list pointers   }
   NLINKS :   integer;                      { to monitor performance }
   infile, outfile : text;                  { input/output files     }

{ * * * * * end of global declarations * * * * * }

procedure filerewrite ( var name_of_file : text);

begin
{ssign (name_of_file, 'M:HASH.TXT' );}
rewrite (name_of_file,'hash.out');
end; {rewrite}

procedure filereset ( var name_of_file : text);

begin {filereset}
{ssign (name_of_file, 'b:phone.dat');}
reset  (name_of_file,'phone_data.2');

end; {filereset}

procedure freecell (cell : ptr);
begin
dispose (cell);

end; {freecell}

FUNCTION isdigit (c: character): boolean;
   { Returns "true" if "c" is a digit }
begin
isdigit := c in [ord('0')..ord('9')]
end; { isdigit }

FUNCTION isletter (c: character): boolean;
   { Returns `true` if "c" is a letter }
begin
isletter := c in [ord('a')..ord('z')] + [ord('A')..ord('Z')]
end; { isletter }

FUNCTION getc (var f: text; var c: character): character;
   { get a single character from the file "f" }
   var  ch : char;
begin
if (eof(f))
   then c := ENDFILE
   else if (eoln(f))
           then begin
                readln(f);
                c := NEWLINE
                end
           else begin
                read(f, ch);
                c := ord(ch)
                end;
getc := c;
end; { getc }

{ * * * * * * * End of low-level CHARACTER procedures * * * * * * }

FUNCTION getname(var f: text; var name: name_type): character;
   { get (read) a "name" from the file "f" }
   var  i : integer;
        done : boolean;
        c : character;
begin
i := 0;
done := false;
while (not done) do
      begin
      c := getc(f, c);
      if (c = ENDFILE)
         then done := true
         else if (isletter(c))
                 then begin
                      i := i + 1;
                      name[i] := c;
                      if (i = (MAXNAME - 1))
                         then done := true
                      end
                 else if (i <> 0)
                      then done := true;
        end; { while }
   i := i + 1;
   name[i] := ENDSTR;
   if ((c = ENDFILE) and (i <= 1))
      then getname := ENDFILE
      else getname := 1;
end; { getname }

FUNCTION getnumber(var f: text; var number: phonenumbertype): character;
   { Get (read) a phone number from the file "f" }

  var
      i   : integer;
      done : boolean;
      c   : character;
begin
i := 0;
done := false;
while (not done) do
      begin
      c := getc(f, c);
      if ((c = ENDFILE) or (c = NEWLINE))
         then done := true
         else if (isdigit(c) or (c = DASH))
                 then begin
                      i := i + 1;
                      number[i] := c;
                      if (i = (MAXNUMBER - 1))
                         then done := true
                      end
                 else if (i <> 0)        { ignore leading garbage }
                         then done := true;
      end; { while }
i := i + 1;
number[i] := ENDSTR;
if ((c = ENDFILE) and (i <= 1))
   then getnumber := ENDFILE
   else getnumber := 1;
end; { getnumber }

FUNCTION getdata (var f: text; var person: info): character;
   { This procedure reads the name and phone number from the text file f.
   { Note: 1. any string of maxstring letters are the name
   {       2. leading blanks are ignored.
   {       3. any none alpabetic character terminates the name
   }
begin
getdata := getname(f, person.name);
getdata := getnumber(f, person.phonenumber);
end; { getdata }

PROCEDURE putname(var f: text; var s: name_type);
   { write a "name" on file "f" }
   var  i: integer;
begin
i := 1;
while (s[i] <> ENDSTR) do
      begin
      write (f, chr(s[i]));
      i := i + 1
      end
end; { putname }

PROCEDURE putnumber(var f: text; var number : phonenumbertype);
   { write a phone number on the file "f" }
var
   i: integer;
begin
   i := 1;
   while (number [i] <> ENDSTR) do begin
      write(f, chr(number [i]));
      i := i + 1
      end
end; { putnumber }

FUNCTION namlength (name : name_type) : integer;
   { Returns the number of characters in "name".  }
   var  i : integer;
begin
i := 1;
while (name[i] <> ENDSTR) do
        i := i+1;
namlength := i-1;
end;

FUNCTION numlength (number : phonenumbertype) : integer;
   { Returns the number of characters in "number".  }
   var  i : integer;
begin
i := 1;
while (number[i] <> ENDSTR) do
        i := i+1;
numlength := i-1;
end;

FUNCTION lex_equal (var nm1, nm2: name_type) : boolean;
   { Returns "true" if the two names are lexicographically equal }
   var
     i : integer;
     l_equal : boolean;

begin {lex_equal}

i := 1;
while ((nm1[i] = nm2[i]) and (nm1[i] <> ENDSTR)) do
    i := i + 1;
l_equal := ((nm1[i] = ENDSTR) and (nm1[i] = nm2[i]));
{
if l_equal
  then writeln ('equal')
  else writeln ('not equal');
}
lex_equal := l_equal;

end; { lex_equal  }

FUNCTION lex_less(var nm1, nm2: name_type): boolean;
   { Return "true" if "nm1" is lexicographically less than "nm2" }
   var  i: integer;
begin
i := 1;
while ((nm1[i] = nm2[i]) and (nm1[i] <> ENDSTR)) do
      i := i + 1;
lex_less := (nm1[i] < nm2[i])
end; { lex_less }

{ * * * * * * * * * End of NAME and NUMBER procedures * * * * * * * * }

PROCEDURE initlist;
   { Initialize the collection of linked lists comprising the       }
   { buckets---they are all empty.                                  }
   var   i : integer;
         node : ptr;
begin
for i := 1 to MAXBUCKETS do
     begin
     BUCKET[i] := nil;
     end;
end;

PROCEDURE dump (var ofile:text);
   { This procedure "dumps" (writes out) the current structure of the }
   { data structure (list in this case) in some appropriate format.   }
   var   item : ptr;
         i,linelength : integer;

begin
writeln (ofile);
writeln (ofile, '  ***    dump of buckets    ***');
writeln (ofile);
for i := 1 to MAXBUCKETS do
     begin                                  { Display i-th bucket }
     write (ofile, 'BUCKET[',i:2,'] : ');
     linelength := 13;
     item := BUCKET[i];
     while (item <> nil) do
          with item^ do
              begin
              if (linelength + 24) > MAXLINELENGTH
                 then begin
                      writeln (ofile);
                      write (ofile, '             ');
                      linelength := 13;
                      end;
              write (ofile, '   ');
              putname (ofile, person.name);
              write (ofile, ',');
              putnumber (ofile, person.phonenumber);
              linelength := linelength + namlength(person.name)
                                       + numlength(person.phonenumber) + 7;
              item := item^.next;
              end;
     writeln (ofile);
     end;
writeln (ofile);
writeln(ofile, '  ***    end of dump    ***');
end;

FUNCTION hash (key : name_type; n : integer) : integer;
   { This function returns an integer in the range [1..n], based on  }
   { the characters in "key".                                        }
var
  sum,
  i,
  j : integer;

begin
sum := 0;
j := namlength (key);
for i := 1 to j do
    sum := sum + key[i];
sum := (sum mod n) + 1;
{ writeln (output, sum); }
hash := sum;
end; {hash}

PROCEDURE enter (var key: info);
   { This routine looks up the given "key" in a phonebook.
   { If the person has already been entered into the phone book,
   { nothing is done, otherwise then a cell denoting this person
   { is added to the phone book.
   {
   {      * * * as a class exercise only * * *
   { "enter" should count the number of links it follows to:
   { 1. find the key, or
   { 2. enter a new key.  (count the newly created link as if
   {                       it had been followed.)
   { and return this value in the global variable "nlinks".
   }

var
  add_it  : boolean;
  cell,
  newcell : ptr;
  i       : integer;

begin {enter}
nlinks := 1;
i := hash (key.name, PRIME_MODULUS);
{putname (output, key.name); putnumber (output, key.phonenumber); }
{ writeln ('enter');}
if bucket[i] = nil
   then begin {put the first link out from the bucket}
        new (cell);
        bucket[i] := cell;
        add_it := false;
        cell^.person := key;
        cell^.next := nil;
        end
   else begin { Go down the chain and see if the name is there}
              { If there, write a duplicate message, else add the }
              { info at the front of the link. }
        cell := bucket[i];
        add_it := true;
        while cell^.next <> nil
            do begin {while}
               if lex_equal (cell^.person.name, key.name)
                  then begin
{---                   writeln ('duplicate found'); }
                       add_it := false;
                       cell^.next := nil;
                       end {then}
                   else begin
                        cell := cell^.next;
{---                    writeln ('down the chain'); }
                        end; {else}
               nlinks := nlinks + 1;
               end; {while moving down the chain}
         end; {else}
if add_it
   then begin
{---    putname (output, key.name);
        writeln (' - add one'); }
        write ('.');
        new (newcell);
        newcell^.next := bucket[i];
        newcell^.person.name := key.name;
        newcell^.person.phonenumber := key.phonenumber;
        bucket[i] := newcell;
        end; {then}

end; {enter}

FUNCTION lookup (var key: info): boolean;
   { Given key, this function looks up that name in the phone book.
   { It returns the true if the person was in the phone book, and
   { sets the record to the phone number;
   { it returns false, if the person is not in phone book.
   }
var
  i,
  j  : integer;
  cell  : ptr;
  found : boolean;

begin
found := false;
i := hash (key.name, PRIME_MODULUS);
cell := bucket[i];
while cell <> nil do
   begin
   if lex_equal (cell^.person.name, key.name)
      then begin
           found := true;
           key := cell^.person;
           cell := nil;
           end {then}
      else begin
{---       writeln;
           if cell <> nil
              then putname (Output, cell^.person.name);
           writeln; }
           cell := cell^.next;
           end; {else}
   end; {while}

lookup := found;

end; { lookup }


PROCEDURE main;
   { This main procedure reads a selection of natural language
   { text, and creates a "phonebook" of every name and number
   { that occurs in the input file.
   { It then dumps the representing data structure, and prints
   { out a variety of counts describing its performance.
   { finally, it reads in a random selection of names, and
   { looks them up in the phonebook.
   }
   var  done: boolean;
        entry: info;
        query: name_type;
        npeople: integer;               { number of people processed }
        maxlinks, totalinks: integer;   { behavior counts }
        avg: real;
begin
NLINKS := 0;
npeople := 0;
totalinks := 0;
maxlinks := 0;
initlist;

   { main while loop.   echo input words and enter them.            }

while (getdata (infile, entry) <> ENDFILE) do
      begin
      enter(entry);

                 { collect counts to monitor access performance }

      npeople := npeople + 1;
      totalinks := totalinks + NLINKS;
      if NLINKS > maxlinks
         then maxlinks := NLINKS;
      NLINKS := 0;
      end;   { main while loop }

                 { dump data structure, and print statistics }
                 { describing the access performance.        }

writeln (outfile);
dump(outfile);
writeln (outfile);
writeln (outfile, ' total number of entries = ', npeople:3);
writeln (outfile, ' total number of links followed = ', totalinks:4);
avg := totalinks / npeople;
writeln (outfile, ' average number of links per entry = ', avg:8:4);
writeln (outfile, ' maximum number of links followed = ', maxlinks:4);

                { test the system with a sequence of random queries }

writeln (outfile);

writeln (output);
writeln (output, '      Process some sample queries');
writeln (output, '      Enter CNTRL D to terminate');
done := false;
while (not done) do
      begin  { look up this query word }
      write (Output, 'name? ');
      if (getname (input, query) = ENDFILE)
         then done := true
         else begin
              writeln;
              entry.name := query;
              if (not lookup (entry))
                 then begin
                      putname (Output, query);
                      writeln (Output, ' is not in the phone book')
                      end {then}
                 else begin
                      writeln;
                      putname (Output, query);
                      write (Output, '''s phone number is ');
                      putnumber (Output, entry.phonenumber);
                      writeln (Output);
                      end;
              end;
      end; { while }
end; { main }

begin
filereset (infile);
filerewrite (outfile);
main;
close (infile);
close (outfile);
end.