home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / PascalPCQ / Examples / Counter2.p < prev    next >
Text File  |  1990-07-19  |  3KB  |  142 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:Utils/Parameters.i"}
  16. {$I "Include:Utils/StringLib.i"}
  17.  
  18. const
  19.     TableSize = 511;
  20.  
  21. type
  22.     WordRec = Record
  23.     Next  : ^WordRec;
  24.     Count : Integer;
  25.     Data  : array [0..255] of char;
  26.     end;
  27.     WordPtr = ^WordRec;
  28.  
  29. var
  30.    Table : Array [0..TableSize] of WordPtr;
  31.    CurrentChar : Char;
  32.    InFile : Text;
  33.    CurrentWord : String;
  34.    TotalWords : Integer;
  35.  
  36. Procedure ReadChar;
  37. begin
  38.     if eof(InFile) then
  39.     CurrentChar := Chr(0)
  40.     else
  41.     Read(Infile, CurrentChar);
  42. end;
  43.  
  44. Procedure SkipWhiteSpace;
  45. begin
  46.     while (not eof(Infile)) and (not isalpha(CurrentChar)) do
  47.     ReadChar;
  48. end;
  49.  
  50. Procedure ReadWord;
  51. var
  52.    i : Integer;
  53. begin
  54.     i := 0;
  55.     while isalnum(CurrentChar) do begin
  56.     CurrentWord[i] := CurrentChar;
  57.     i := Succ(i);
  58.     ReadChar;
  59.     end;
  60.     CurrentWord[i] := Chr(0);
  61. end;
  62.  
  63. Procedure EnterWord(rec : WordPtr);
  64. var
  65.     Result : Short;
  66. begin
  67.     Result := Hash(Adr(rec^.Data)) and TableSize;
  68.     rec^.Next := Table[Result];
  69.     Table[Result] := rec;
  70. end;
  71.  
  72. Procedure AddWord(str : String);
  73. var
  74.     rec : WordPtr;
  75. begin
  76.     rec := WordPtr(AllocString(13 + strlen(str)));
  77.     strcpy(Adr(rec^.Data), str);
  78.     rec^.Count := 1;
  79.     EnterWord(rec);
  80. end;
  81.  
  82. Function FindWord(str : String) : WordPtr;
  83. var
  84.     Current : WordPtr;
  85. begin
  86.     Current := Table[Hash(str) and TableSize];
  87.     while Current <> nil do begin
  88.     if strieq(str, Adr(Current^.Data)) then
  89.         FindWord := Current;
  90.     Current := Current^.Next;
  91.     end;
  92.     FindWord := nil;
  93. end;
  94.  
  95. Procedure Report;
  96. var
  97.     i : Short;
  98.     W : WordPtr;
  99. begin
  100.     for i := 0 to TableSize do begin
  101.     W := Table[i];
  102.     while W <> nil do begin
  103.         Writeln(W^.Count, Chr(9), String(Adr(W^.Data)));
  104.         TotalWords := TotalWords + W^.Count;
  105.         W := W^.Next;
  106.     end
  107.     end
  108. end;
  109.  
  110. var
  111.     W : WordPtr;
  112.     FileName : String;
  113.     index : Integer;
  114. begin
  115.     for index := 0 to TableSize do
  116.     Table[index] := nil;
  117.     CurrentWord := AllocString(128);
  118.     FileName := AllocString(80);
  119.     GetParam(1, FileName);
  120.     if FileName^ = Chr(0) then begin
  121.     Writeln('Usage: Counter2 FileName');
  122.     Exit(10);
  123.     end;
  124.     if reopen(FileName, Infile) then begin
  125.     SkipWhiteSpace;
  126.     while not eof(Infile) do begin
  127.         ReadWord;
  128.         SkipWhiteSpace;
  129.         W := FindWord(CurrentWord);
  130.         if W = nil then
  131.         AddWord(CurrentWord)
  132.         else
  133.         W^.Count := Succ(W^.Count);
  134.     end;
  135.     TotalWords := 0;
  136.     Report;
  137.     Writeln('Total Words: ', TotalWords);
  138.     Close(Infile);
  139.     end else
  140.     Writeln('Could not open the input file : ', FileName);
  141. end.
  142.