program string (input,output,infile,outfile);
{
******************************************************************************
*                                   STRING                                   *
*    This program will either count the number of n letter strings or the    *
* number of n letter words in a file called infile.  The results appear in a *
*                           file called outfile.                             *
*                    Written by Michael Shuter.(MAY 96)                      *
******************************************************************************
}

type
stringtype = array [1..8] of char;
rectype = record
                strin:stringtype;
                number:integer;
          end;
arraytype = array [1..4000] of rectype;

var
list: arraytype;
infile,outfile: text;
amount,m: integer;
choice,option:char;
preview:boolean;

#include "resorting.i";
#include "writing.i";

procedure storingdata(limit:integer; var position:integer; var data:arraytype);
{
**********************************************************
*                      STORINGDATA                       *
*     This is called if the string option is chosen      *
* It reads through a file and stores any n letter string *
**********************************************************
}
var
previous,current: stringtype;
chin:char;
count,counter:integer;

begin
     position:=0;
     counter:=0;
     if eof(infile) then
        writeln('NO DATA IN INFILE')
     else
     begin
          repeat
               read(infile,chin);
               if chin in ['a'..'z','A'..'Z'] then
               begin
		    if chin in ['A'..'Z'] then
                       chin:=chr(ord(chin)+32);{post: chin is lowercase}
		    assert(chin in ['a'..'z']);
                    counter:=counter+1;
                    if counter>limit then {move previous letters down one and add last letter on the end}
                    begin
                         for count:=1 to (limit-1) do
                         begin
                              previous[count]:=previous[count+1];
                         end;
                         previous[limit]:=chin;
                         current:=previous;{POST: array is still full}
                    end{if}
                    else {store in array}
                    begin
                         previous[counter]:=chin;{Array is filling up}
                         if counter=limit then
                            current:=previous;{Array is full}
                    end;{else}
                    if counter>=limit then {string needs to be stored}
                    begin
                         position:=position+1;
                         data[position].strin:=current;
                         data[position].number:=1;{stored with occurence one}
                    end;{if}
               end{if}
               else
                    counter:=0;
	       if eoln(infile) then
               begin
                    readln(infile);
                    counter:=0;
               end;{if}
          until eof(infile){end;}
     end;{else}
end;{storingdata}

procedure storwords(limit:integer; var position:integer; var data:arraytype);
{
*********************************************************
*                       STORWORDS                       *
*      This is called if the word option is chosen      *
* It reads through a file and stores any n letter words *
*********************************************************
}
var
current: stringtype;
chin:char;
counter:integer;
bob:boolean;

begin
     position:=0;
     counter:=0;
     if eof(infile) then
        writeln('NO DATA IN INFILE')
     else
     begin
          while not eof(infile) do
          begin
               read(infile,chin);
	       bob:=true;
               if eoln(infile) then
               begin
		    if counter=(limit-1) then
			bob:=false{needs to be stored as a word}
		    else
                    begin
			counter:=0;{begin counting again}
			readln(infile);
			if not eof(infile) then
				read(infile,chin);
		    end;{else}
               end;{if}
               if chin in ['a'..'z','A'..'Z'] then
               begin
                    if chin in ['A'..'Z'] then
                       chin:=chr(ord(chin)+32);{post: chin is a lowercase letter}
                    counter:=counter+1;
                    if counter<=(limit) then
                       current[counter]:=chin;{store letter in array}
		    if bob=false then{eoln and word needs to be stored}
		    begin
                         readln(infile);
			 position:=position+1;
                         data[position].strin:=current;
                         data[position].number:=1;
                         counter:=0;{reset counter}
                    end;{if}
               end{if}
               else
               begin
                    if (counter=limit) then {store as word due to punctuation}
                    begin
                         position:=position+1;
                         data[position].strin:=current;
                         data[position].number:=1;
                    end;{if}
                    counter:=0;{reset counter}
               end;{else}
	       
          end;{while}
     end;{else}
     writeln('Finished storing data');
end;{storwords}


procedure quicksort(start,finish,n: integer; var list:arraytype);
{
************************************************************
*                        QUICKSORT                         *
* This sorts the array into alphabetic order of the string *
************************************************************
}
var
left,right,plod1,plod2: integer;
startervalue,temp:stringtype;
check1,check2: boolean;

begin
     left:=start;
     right:=finish;
     startervalue:= (list[(start+finish)div(2)].strin);{picks middle value}
     repeat
           plod1:=1;
           repeat{left of startervalue}
           	repeat{compares a record with the startervalue}
                 if (ord(list[left].strin[plod1]))<(ord(startervalue[plod1])) then
                    check1:=true;
                 if (ord(list[left].strin[plod1]))=(ord(startervalue[plod1])) then
                    begin
                    	check1:=false;
                    	plod1:=plod1+1;
                    end;{if}
                 if (ord(list[left].strin[plod1]))>(ord(startervalue[plod1])) then
                    begin
                    	plod1:=n+1;
                    	check1:=false;
                    end;{if}
           until (plod1=n+1) or (check1=true);
           if check1=true then
           begin
                 left:=left+1;
                 plod1:=1;
           end;{if}
           until plod1=n+1;
           plod2:=1;
           repeat{right of startervalue}
           	repeat
                 if (ord(list[right].strin[plod2]))>(ord(startervalue[plod2])) then
                    check2:=true;
                 if (ord(list[right].strin[plod2]))=(ord(startervalue[plod2])) then
                    begin
                         check2:=false;
                         plod2:=plod2+1;
                    end;{if}
                 if (ord(list[right].strin[plod2]))<(ord(startervalue[plod2])) then
                    begin
                         plod2:=n+1;
                         check2:=false;
                    end;{if}
           until (plod2=n+1) or (check2=true);
           if check2=true then
           begin
                 right:=right-1;
                 plod2:=1;
           end;{if}
           until plod2=n+1;
           if left<=right then{swap the two about startervalue}
           begin
                temp:=list[left].strin;
                list[left].strin:=list[right].strin;
                list[right].strin:=temp;
                left:=left+1;
                right:=right-1;
           end;{if}
     until right<=left;{until all positions have been checked}
     if start<right then quicksort(start,right,m,list);{recurs until all halves have been checked}
     if left<finish then quicksort(left,finish,m,list);{recurs until all halves have been checked}
end;{quicksort}{post: array is in alphabetic order}

procedure combine(p:integer; var limit:integer; var data:arraytype);
{
****************************************************************
*                           COMBINE                            *
* Combines two positions in an array if the string is the same *
****************************************************************
}
var
stroll,walk:integer;
bob:boolean;

begin
     stroll:=2;
     repeat
          walk:=1;
          bob:=false;
          repeat{checks all positions in array until one position is different}
                if (ord(data[stroll-1].strin[walk]))=(ord(data[stroll].strin[walk])) then
                   walk:=walk+1
                else
                    bob:=true;
          until (walk=p+1) or bob=true;
          if (walk=p+1) then {the records are the same therefore combine}
          begin
               data[stroll].number:=((data[stroll-1].number)+1);
	       data[stroll-1].strin[1]:='~'{assigns a value that could not have been stored}
          end{if}
          else
		stroll:=stroll+1;
     until stroll>limit+2;{all fields have been checked}
end;{combine}{post: no two positions have the same string}


begin
     reset(infile);
     rewrite(outfile);
     preview:=false;
     write('Enter m : ');
     readln(m);
     repeat
           write('Do you want debug on (y/n): ');
           readln(option);
     until option in ['y','n','Y','N'];
     if option in ['y','Y'] then
	preview:=true;
     repeat
           write('Do you want to count (w)ords or (s)trings : ');
           readln(choice);
     until choice in ['w','s','W','S'];
     if (choice='s') or (choice='S') then
        storingdata(m,amount,list)
     else
          storwords(m,amount,list);
     if amount=0 then
        writeln('No strings/words of that length')
     else
     begin
     	  if preview then
		create(amount,m,list);
	  if amount>1 then{sort,combine,resort}
     	  begin
	       quicksort(1,amount,m,list);
	       if preview then
		create(amount,m,list);
	       combine(m,amount,list);
	       if preview then
		create(amount,m,list);
               resort(1,amount,list);{this resorts the array so that large occurences occur first}{post:largest occurences are first}
          end;{if}
     create(amount,m,list);{this writes the results}
     end;{else}
end.{program}