program IndiceTesto;
const
MaxLungParola = 30;
MaxNumParole = 500;
CarattereFinale = '#';
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 parola: TipoParola; var fine: boolean;
var ch: char);
var
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 ch <> CarattereFinale then
repeat
read(ch)
until (ch = CarattereFinale) or AlfaNumerico(ch);
if ch = CarattereFinale then
fine := TRUE
else
begin
fine := FALSE;
lung := 0;
repeat
lung := lung + 1;
if lung <= MaxLungParola then
parola[lung] := Maiuscola(ch);
read(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
fine : boolean;
carattere : char;
parola : TipoParola;
indice : TipoIndice;
begin
writeln('Immetti una sequenza di parole terminata da ''#''! ');
carattere := ' ';
indice.numero_elementi := 0;
LeggiParolaSuccessiva(parola, fine, carattere);
while not fine do
begin
AggiungiIndice(parola, indice);
LeggiParolaSuccessiva(parola, fine, carattere);
end;
writeln;
StampaIndice(indice)
end.