home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 300-399 / ff339.lzh / PCQ / Examples / Counter2.p < prev    next >
Text File  |  1990-03-19  |  3KB  |  143 lines
  1. Program Counter2;
  2.  
  3. {
  4. This program reads a text file, then prints a report telling
  5. you all the words in the file, and how many times each was
  6. used.  It was intended as a demonstration and test of string
  7. stuff and some addressing things.  The other major reason I
  8. wrote it is because I am currently re-writing the compiler's
  9. symbol table stuff, and the two designs I'm thinking about are
  10. binary trees and hash tables.  I am going to use the hash
  11. tables, but I wanted to get familiar with both methods before
  12. I started the actual work.  This program uses the hash tables.
  13. }
  14.  
  15. {$I ":Include/Ports.i"}
  16. {$I ":Include/Parameters.i"}
  17. {$I ":Include/StringLib.i"}
  18.  
  19. const
  20.     TableSize = 511;
  21.  
  22. type
  23.     WordRec = Record
  24.     Next  : ^WordRec;
  25.     Count : Integer;
  26.     Data  : array [0..255] of char;
  27.     end;
  28.     WordPtr = ^WordRec;
  29.  
  30. var
  31.    Table : Array [0..TableSize] of WordPtr;
  32.    CurrentChar : Char;
  33.    InFile : Text;
  34.    CurrentWord : String;
  35.    TotalWords : Integer;
  36.  
  37. Procedure ReadChar;
  38. begin
  39.     if eof(InFile) then
  40.     CurrentChar := Chr(0)
  41.     else
  42.     Read(Infile, CurrentChar);
  43. end;
  44.  
  45. Procedure SkipWhiteSpace;
  46. begin
  47.     while (not eof(Infile)) and (not isalpha(CurrentChar)) do
  48.     ReadChar;
  49. end;
  50.  
  51. Procedure ReadWord;
  52. var
  53.    i : Integer;
  54. begin
  55.     i := 0;
  56.     while isalnum(CurrentChar) do begin
  57.     CurrentWord[i] := CurrentChar;
  58.     i := Succ(i);
  59.     ReadChar;
  60.     end;
  61.     CurrentWord[i] := Chr(0);
  62. end;
  63.  
  64. Procedure EnterWord(rec : WordPtr);
  65. var
  66.     Result : Short;
  67. begin
  68.     Result := Hash(Adr(rec^.Data)) and TableSize;
  69.     rec^.Next := Table[Result];
  70.     Table[Result] := rec;
  71. end;
  72.  
  73. Procedure AddWord(str : String);
  74. var
  75.     rec : WordPtr;
  76. begin
  77.     rec := WordPtr(AllocString(13 + strlen(str)));
  78.     strcpy(Adr(rec^.Data), str);
  79.     rec^.Count := 1;
  80.     EnterWord(rec);
  81. end;
  82.  
  83. Function FindWord(str : String) : WordPtr;
  84. var
  85.     Current : WordPtr;
  86. begin
  87.     Current := Table[Hash(str) and TableSize];
  88.     while Current <> nil do begin
  89.     if strieq(str, Adr(Current^.Data)) then
  90.         FindWord := Current;
  91.     Current := Current^.Next;
  92.     end;
  93.     FindWord := nil;
  94. end;
  95.  
  96. Procedure Report;
  97. var
  98.     i : Short;
  99.     W : WordPtr;
  100. begin
  101.     for i := 0 to TableSize do begin
  102.     W := Table[i];
  103.     while W <> nil do begin
  104.         Writeln(W^.Count, Chr(9), String(Adr(W^.Data)));
  105.         TotalWords := TotalWords + W^.Count;
  106.         W := W^.Next;
  107.     end
  108.     end
  109. end;
  110.  
  111. var
  112.     W : WordPtr;
  113.     FileName : String;
  114.     index : Integer;
  115. begin
  116.     for index := 0 to TableSize do
  117.     Table[index] := nil;
  118.     CurrentWord := AllocString(128);
  119.     FileName := AllocString(80);
  120.     GetParam(1, FileName);
  121.     if FileName^ = Chr(0) then begin
  122.     Writeln('Usage: Counter2 FileName');
  123.     Exit(10);
  124.     end;
  125.     if reopen(FileName, Infile) then begin
  126.     SkipWhiteSpace;
  127.     while not eof(Infile) do begin
  128.         ReadWord;
  129.         SkipWhiteSpace;
  130.         W := FindWord(CurrentWord);
  131.         if W = nil then
  132.         AddWord(CurrentWord)
  133.         else
  134.         W^.Count := Succ(W^.Count);
  135.     end;
  136.     TotalWords := 0;
  137.     Report;
  138.     Writeln('Total Words: ', TotalWords);
  139.     Close(Infile);
  140.     end else
  141.     Writeln('Could not open the input file : ', FileName);
  142. end.
  143.