Práce s textem – Pascal – Fórum – Programujte.com

Ahoj, mám naprogramovat prrográmek:

Vstupem bude dlouhý text v přirozeném jazyce.

Výstupem bude slovník všech slov, která se v textu vyskytla (podle abecedy) a u každého slova bude četnost výskytů. Dále budou u každého slova uvedeny tři nejčastější slova, která se vyskytují těsně za ním + četnost výskytu těchto tří dvojic.

Už jsem udělala seznam všech slov seřazený podle abecedy i s počtem jejich výskytu, ale nemůžu hnout s těmi slovy za nimi...
Mohl byste mi někdo prosím poradit? Budu ráda za každu radu.

Děkuju moc

řešil bych:
na začátku rozparsuji na slovník slov se strukturou:
sslovo=record
ind:integer; - index pro druhe slovo
pocet:integer;
end;
sslovnik = record
retezec:String[25];
index:integer; -pozice
vyskyt:word;
end;
slovnik:array[1..2000]of sslovnik;
slovo2:array[1..1000,1..3]of sslovo; -pro druhe slovo v paru
pomocne:array[1..100]of sslovo;
pocetslov,pocetindexu:word; -tady si ulozim maxima
pomocnyindex:word; -vyuziti: aktualniindex + az budu projizdet seznam slov za

Proberu se dvema vnorenymi cykly skrze vsechna slova za sebou a indexuji si je
(v podcyklu provadim porovnani se vsemi slovy od "prvniho" az po posledni),
pokud narazim na stejne slovo dam mu stejny index+zvysim vyskyt.
Pokud ma slovo uz index>0 ve vnejsim cyklu ho preskocim.

Pro dalsi cast ukolu-
projedu znova cely slovnik (s promennou x) tentokrat podle indexu,
prvni slovo (index=1) az posledni zaindexovane.

Udelam to 2*cyklem while
pomocnyindex:=1;
while pomocnyindex<pocetindexu
x:=0;
while x<pocetslov begin
x:=x+1;
If slovnik[x].index=pomocnyindex then
begin
Do pomocne[] budu davat vsechna slova, ktera jsou nasledovne ve slovnik[x+1], a to presneji
jen jejich index => pomocne[1].ind:=slovnik[x+1].index;
pomocne[1].pocet:=1;
(( Hlidam napred samozrejme v dalsim podcyklu ze uz zaznamenane slovo existuje
If pomocne[i].ind=slovnik[x+1].index then inc(pomocne[i].pocet); ))

end;
Tri nejvyssi vyskyty ZDE cyklem prekopiruji do slovo2[pomocnyindex,1..3] (zaroven mam i jejich pocet/vyskyt)
napr. slovo2[pomocnyindex,1].ind:=pomocne[i].ind;
end;

Kdyz delam ve Freepascalu a mam jeste vice pameti pouziji misto pomocne[100] radeji pomocne^[pocetindexu] a usetrim tak 1 vnitrni cykl.
Pokud mam NAOPAK malo pameti udelam slovnik jen unikatnich slov a jejich pozici ve Vete
si dam do pole. Pak budu pri hledani slova ZA, prochazet vsechna slova (vcetne porovnavaneho)
a porovnavat pozici/index zase s " x+1 ".
sslovnik = record
retezec:String[25];
index:array[1..50]of integer; -Xkrat pozice ve Vete
vyskyt:word; -pocet
end;
(snad to nemam nejak derave)

program ukol24;

uses crt;

const {konstanta pro generovani dotazu behem zadani}

{*tady máš onu(podobnou) položku jenom zadáš jejich počet a načteš do programu*}

   polozka: array[1..4] of string= ('prijmeni','jmeno',

   'telefonni cislo','cislo na mobil');

var

   zadani,radek,soubor:string;

   s:text;                    {textovy soubor}

   i:integer;

   odpoved:char;



procedure novy; {vytvori novy soubor}

 begin

  rewrite(s);

   write(s,'Prijmeni':15); {a zapise do neho hlavicku}

   write(s,'Jmeno':15);

   write(s,'Telefon':15);

   writeln(s,'Mobil':15);

   for i:=1 to 60 do write(s,'-');

   writeln(s);

  close(s);

 end;



procedure inicializace;

 begin

  clrscr;

  write('Jmeno souboru: '); {vyber souboru}

  readln(soubor);

  assign(s,soubor);

  {$I-}

  reset(s);             {testuje jestli soubor existuje}

  {$I+}

  if ioresult<>0 then novy {kdyz ne tak ho vytvori}

   else close(s);

 end;



procedure vypis; {vypise obsah souboru}

 begin

  clrscr;

  reset(s);

  while not eof(s) do begin

   readln(s,radek);

   writeln(radek);

  end;

  repeat until keypressed;

  close(s);

 end;



procedure vymaz; {vymaze aktualni soubor}

 begin

  clrscr;

  erase(s);

  writeln('Soubor ',soubor,' byl smazan!');

  writeln('Chcete vybrat jiny soubor A/N');

  if upcase(readkey)='A' then inicializace {otevre bud jiny soubor}

   else halt;                              {nebo ukonci program}

 end;



procedure pridat; {prida polozku do souboru}

 begin

 append(s);

 repeat

    clrscr;



    for i:=1 to 4 do begin {generuje dotaz pomoci konstant}

    write('Zadejte ',polozka[i],': ');

    readln(zadani);

    write(s,zadani:15);

    end;



   writeln(s);

   writeln('----------------------');

   writeln('Dalsi zaznam? (A/N)');

  until upcase(readkey)<>'A';

  close(s);

 end;



begin   { hlavni program - menu}

 inicializace;

 repeat

  clrscr;

  writeln('Soubor: ',soubor);

  writeln('---------------------');

  writeln('Vypsat obsah ...... V');

  writeln('Pridat polozku .... P');

  writeln('Smazat soubor ..... S');

  writeln('Zmena souboru ..... Z');

  writeln('---------------------');

  writeln('Konec ........... Esc');

  odpoved:=upcase(readkey);

  case odpoved of

   'V': vypis;

   'P': pridat;

   'Z': inicializace;

   'S': vymaz;

  end;

 until odpoved=chr(27);

end.