program IndiceTestoSuFile;
const
MaxLungParola = 30;
MaxNumParole = 500;
type
TipoIndiceCar = 1..MaxLungParola;
TipoParola = packed array [TipoIndiceCar] of char;
TipoIntervalloIndice = 1..MaxNumParole;
TipoOccorrenza = record
parola : TipoParola;
occorrenza : 0..MAXINT
end;
TipoArrayParole = array [TipoIntervalloIndice] of TipoOccorrenza;
TipoIndice = record
lista_parole : TipoArrayParole;
numero_elementi : 0..MaxNumParole
end;
procedure LeggiParolaSuccessiva (var f: text; var parola: TipoParola;
var fine: boolean);
var
ch : char;
i, lung : integer;
function AlfaNumerico (ch: char): boolean;
begin
AlfaNumerico := ((ch >= 'a') and (ch <= 'z')) or
((ch >= 'A') and (ch <= 'Z')) or
((ch >= '0') and (ch <= '9'))
end;
function Maiuscola (ch: char): char;
begin
if (ch >= 'a') and (ch <= 'z') then
Maiuscola := chr(ord(ch) - ord('a') + ord('A'))
else
Maiuscola := ch
end;
begin
if not eof(f) then
repeat
read(f, ch)
until eof(f) or AlfaNumerico(ch);
if eof(f) then
fine := TRUE
else
begin
fine := FALSE;
lung := 0;
repeat
lung := lung + 1;
if lung <= MaxLungParola then
parola[lung] := Maiuscola(ch);
read(f, ch)
until not AlfaNumerico(ch);
for i := lung + 1 to MaxLungParola do
parola[i] := ' '
end
end;
procedure AggiungiIndice (parola: TipoParola; var indice: TipoIndice);
var
i : integer;
posizione_trovata : boolean;
procedure InserisciParola(posizione: TipoIntervalloIndice);
var
j : TipoIntervalloIndice;
begin
with indice do
begin
numero_elementi := numero_elementi + 1;
for j := numero_elementi downto posizione+1 do
lista_parole[j] := lista_parole[j-1];
lista_parole[posizione].parola := parola;
lista_parole[posizione].occorrenza := 1
end
end;
begin
i := 1;
posizione_trovata := FALSE;
with indice do
begin
while (i <= numero_elementi) and (not posizione_trovata) do
if lista_parole[i].parola < parola then
i := i + 1
else
posizione_trovata := TRUE;
if posizione_trovata then
if lista_parole[i].parola = parola then
lista_parole[i].occorrenza := lista_parole[i].occorrenza + 1
else
InserisciParola(i)
else
InserisciParola(i)
end
end;
procedure StampaIndice(var indice: TipoIndice);
var
i : TipoIntervalloIndice;
begin
writeln('Lista di parole nel testo:');
with indice do
for i := 1 to numero_elementi do
writeln(lista_parole[i].parola, ' ', lista_parole[i].occorrenza:3)
end;
var
nome : string;
f : text;
fine : boolean;
parola : TipoParola;
indice : TipoIndice;
begin
writeln('Nome del file da analizzare? ');
readln(nome);
Assign(f, nome);
Reset(f);
indice.numero_elementi := 0;
LeggiParolaSuccessiva(f, parola, fine);
while not fine do
begin
AggiungiIndice(parola, indice);
LeggiParolaSuccessiva(f, parola, fine);
end;
Close(f);
StampaIndice(indice)
end.