Letöltés: mp_telefon2.pas Program telefon; Type szok=record szo,kod:string[50]; End; elt=record hova:byte; melyiks:string[50]; End; elek=record el:array[1..100] of elt; db:byte; End; csucs=record mennyi:byte; honnan:byte; el:byte; End; Var szamok:array[0..9] of set of char; be:text; szam:string; db:longint; szavak:array[1..50000] of szok; graf:array[0..100]of elek; hossz:byte; graf2:array[0..100]of csucs; ki:string; i,hol:byte; Procedure betuszam; Begin szamok[1]:=['i','j']; szamok[2]:=['a','b','c']; szamok[3]:=['d','e','f']; szamok[4]:=['g','h']; szamok[5]:=['k','l']; szamok[6]:=['m','n']; szamok[7]:=['p','r','s']; szamok[8]:=['t','u','v']; szamok[9]:=['w','x','y']; szamok[0]:=['o','q','z']; End; Procedure beolvas; Var i:longint; Begin assign(be,'PHONE.I4'); reset(be); readln(be,szam); hossz:=length(szam); readln(be,db); for i:=1 to db do Begin readln(be,szavak[i].szo); End; close(be); End; Function kodja(s:string):string; Var i:byte; Begin kodja:=''; for i:=1 to length(s) do Begin if s[i] in szamok[0] then kodja:=kodja+'0'; if s[i] in szamok[1] then kodja:=kodja+'1'; if s[i] in szamok[2] then kodja:=kodja+'2'; if s[i] in szamok[3] then kodja:=kodja+'3'; if s[i] in szamok[4] then kodja:=kodja+'4'; if s[i] in szamok[5] then kodja:=kodja+'5'; if s[i] in szamok[6] then kodja:=kodja+'6'; if s[i] in szamok[7] then kodja:=kodja+'7'; if s[i] in szamok[8] then kodja:=kodja+'8'; if s[i] in szamok[9] then kodja:=kodja+'9'; End; End; Procedure kodol; Var i:longint; Begin for i:=1 to db do Begin szavak[i].kod:=kodja(szavak[i].szo); End; End; Procedure grafelek; Var i,j,k:longint; jo:boolean; Begin for i:=1 to db do Begin for j:=1 to hossz-length(szavak[i].kod)+1 do Begin jo:=true; for k:=1 to length(szavak[i].kod) do Begin if szavak[i].kod[k]<>szam[j+k-1] then jo:=false; End; if jo then Begin graf[j-1].db:=graf[j-1].db+1; graf[j-1].el[graf[j-1].db].hova:=j+length(szavak[i].kod); graf[j-1].el[graf[j-1].db].melyiks:=szavak[i].szo; End; End; End; End; Procedure grafv; Var i:byte; Begin for i:=1 to hossz do Begin graf2[i].mennyi:=255; End; End; Procedure keres; Var i,j:byte; tortent:boolean; Begin tortent:=true; while tortent do Begin tortent:=false; for i:=0 to hossz do Begin if graf[i].db>0 then for j:=1 to graf[i].db do Begin if graf2[i].mennyi+1 < graf2[graf[i].el[j].hova-1].mennyi then Begin graf2[graf[i].el[j].hova-1].mennyi:=graf2[i].mennyi+1; graf2[graf[i].el[j].hova-1].honnan:=i; graf2[graf[i].el[j].hova-1].el:=j; tortent:=true; End; End; End; End; End; Begin beolvas; betuszam; kodol; grafv; grafelek; keres; hol:=hossz; ki:=''; if graf2[hossz].mennyi=255 then writeln('Nincs megoldas') else Begin for i:=1 to graf2[hossz].mennyi do Begin ki:=graf[graf2[hol].honnan].el[graf2[hol].el].melyiks+' '+ki; hol:=graf2[hol].honnan; End; writeln(ki); End; End. |