Programozás‎ > ‎Feladatok‎ > ‎Telefonszámok‎ > ‎Megoldás‎ > ‎

mp_telefon2.pas

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.