{ Programm 7.16 von Rene' Scholz }

program counter (input,output);

uses crt;

const Alp    = ['A'..'Z' , 'a'..'z'];

type woerter = ^worte;
     worte   = record  wort  : string;
                       count : integer;
                       next  : woerter;
               end;

var erstes,voriges,
    aktuelles                : woerter;
    dat                      : text;

{
procedure  cls;
begin
 writeln( chr(27), '[2J', chr(27), '[;H' );
end;
}



function next_bs :char;
var bs : char;
begin
  bs:=' ';
  while not ( eof(dat) or (bs in Alp) ) do read(dat,bs);
  if not (bs in Alp) then bs:=' ';
  next_bs:=bs;
end;




function lese_wort :string;
var  hs:string;
     bs:char;
     i:integer;

begin
 i:=1;hs:='';
 bs:=next_bs;
 if bs<>' ' then
     while (bs in Alp) do
       begin
         hs[i]:=bs;
         read(dat,bs);
         i:=i+1;
       end;
 hs[0]:=chr(i-1);      { VAX : hs.length:=0; }
lese_wort:=hs;
end;                             { of lese_wort }




function zaehle( wort : string):integer;
var count : integer;
    mw    : string;

begin
 count:=0;
 mw:='';
 while not eof(dat) do
    begin
      mw:=lese_wort;
      if mw=wort then count:=count+1;
    end;
 zaehle:=count;
end;                       { of function zaehle }





procedure look_for_w ( w:string );
begin

 if erstes^.next=NIL then
   begin
      new(aktuelles);
      aktuelles^.wort  :=w;
      aktuelles^.count :=1;
      aktuelles^.next  :=NIL;
      voriges^.next:=aktuelles;
      voriges:=aktuelles;
   end

 else
  begin
   aktuelles:=erstes^.next;
   while (aktuelles^.wort <> w ) and (aktuelles^.next <> NIL )
      do  aktuelles:=aktuelles^.next;

   if aktuelles^.wort = w then  aktuelles^.count:=aktuelles^.count + 1
   else begin
          new(aktuelles);
          aktuelles^.wort  :=w;
          aktuelles^.count :=1;
          aktuelles^.next  :=NIL;
          voriges^.next:=aktuelles;
          voriges:=aktuelles;
        end;
  end;
end;               { of procedure look_for_w }





function haeufigstes_wort (var nh:integer ; var max_w:string) :boolean;
var z           : char;
    wort        : string;      { hier Speicherung des
                                 gelesenen Wortes des Files }
    i,count     : integer;
    monoton     : boolean;

begin
 i:=0;

 new(aktuelles);
 erstes:=aktuelles;
 erstes^.wort:='';
 erstes^.count:=0;
 erstes^.next:=NIL;
 aktuelles:=erstes;
 voriges:=erstes;

 wort:=lese_wort;
 while wort<>'' do
    begin
      look_for_w(wort);
      wort:=lese_wort;
    end;                          { alle Woerter in Liste eingelesen }

 aktuelles:=erstes^.next;         { jetzt schauen, welches wort am
                                    haeufigsten ist }
 nh:=aktuelles^.count;
 max_w:=aktuelles^.wort;

 while aktuelles^.next <> NIL do
  begin
    aktuelles:=aktuelles^.next;
    count:=aktuelles^.count;
    if count >=nh then
                    begin
                      if count>nh then
                        begin
                          nh    :=aktuelles^.count;
                          max_w :=aktuelles^.wort;
                          monoton:=false;
                        end
                      else monoton:=true;
                    end;
  end;
 haeufigstes_wort:=monoton;
end;






procedure haeufige_woerter(h :integer);
var ls,i   : integer;
    st     : string;
    weiter : string[1];

begin;
 i:=5;
 clrscr;
 writeln('            Es gibt mehrere Woerter',
                      'mit gleicher max. Haeufigkeit : ');
 writeln;writeln;writeln;

 aktuelles:=erstes;
 repeat
   aktuelles:=aktuelles^.next;
   if aktuelles^.count=h
     then
       begin
        if i=22 then
          begin
            writeln;
            write(' Hit  ENTER  for more ');
            readln(weiter);
            clrscr;
            i:=1;
          end;

        st:=aktuelles^.wort;
        ls:=length(st);
        while  (ls<25)  do
          begin
            st:=st + ' ';
            ls:=ls+1;
          end;
        writeln(st, '      :      ',aktuelles^.count :4);
        i:=i+1;
     end;
 until ( aktuelles^.next = NIL );
end;




procedure show_all_words ;  { Alle Woerter mit ihrer Anzahl zeigen }
var i,ls    : integer;
    weiter  : string[1];
    st      : string;
begin
 i:=5;
 clrscr;
 writeln('               Anzeige der Haeufigkeiten aller Woerter ');
 writeln;writeln;writeln;
 aktuelles:=erstes;

 if erstes^.next <> NIL then
   repeat
       if i=22 then
         begin
           writeln;
           write(' Hit  ENTER  for more ');
           readln(weiter);
           clrscr;
           i:=1;
         end;
       aktuelles:=aktuelles^.next;
       st:=aktuelles^.wort;
       ls:=length(st);
       while  (ls<25)  do
         begin
           st:=st + ' ';
           ls:=ls+1;
         end;
       writeln(st, '      :      ',aktuelles^.count :4);

       i:=i+1;
   until aktuelles^.next=NIL;

end;



{ Main }

var datei,wt,weiter  :string;
    hw               :integer;
    mono             :boolean;

begin
 wt:='';hw:=0;weiter:='';
 clrscr;

 writeln('       Programm :  Haeufigkeit von Woertern in einem File ');
 writeln;writeln;
 writeln('Geben Sie das gewuenschte File ein , Enter == "Zitate.txt"   ! ');
 write('    File ?     '); readln(datei);
 if datei=''
   then  datei:='zitate.txt'
   else  if pos('.',datei)=0  then  datei:=datei + '.pas';
 writeln('    File --->  ',datei);
 assign(dat,datei);

 writeln;writeln;
 write('Geben Sie das fragliche Wort ein  :    '); readln(wt);

 reset(dat);
 writeln;writeln;
 if wt<>''
   then writeln('Das Wort  "' ,wt, '"  kam insgesamt ',
                 zaehle(wt), ' mal vor . ');
 writeln;writeln;
 write('                        Hit ENTER for more '); readln(weiter);
 writeln('                    ** plaese wait a minute ** ');

 if wt<>'' then reset(dat);
 mono:=haeufigstes_wort(hw,wt);
 if not mono then
   begin
     writeln;writeln;
     writeln(' Das haeufigste Wort ist:  "', wt,
                 '" . Es kam insgesamt ', hw , ' mal vor .' )
   end
 else haeufige_woerter(hw);

 writeln;writeln;
 write('                        Hit ENTER for more ');
 readln(weiter);

 show_all_words;

 writeln;writeln;
 write('                        Hit ENTER for End '); readln(weiter);

 close(dat);
 clrscr;
 writeln(' By. ');
end.