Listing TELEFON.PAS Program phone; const ni='phone.in'; no='phone.out'; pmax=100; nmax=50000; cmax=10000; lmax=30; type sir=array [1..cmax] of char; psir=^sir; mat=array [1..lmax] of psir; vector=array [1..nmax] of byte; pvector=^vector; var f:Text; a:mat; lng:pvector; ok:array [0..9,'a'..'z'] of Longint; nr,use,cuse,stl,stc: array [1..pmax] of Longint; v,used,jump:array [0..pmax] of Longint; numar,vali:string; n,l,c,i,j,k,h,p,cate,aux,sl,sc: Longint; er:Integer; ch:Char; test:Boolean; procedure load; begin Assign(f,ni); Reset(f); Readln(f,numar); Readln(f,n); New(lng); l:=1; c:=0; New(a[1]); for i:=1 to n do begin readln(f,vali); lng^[i]:=Length(vali); for j:=1 to Length(vali) do begin c:=c+1; if c>cmax then begin l:=l+1; c:=1; New(a[l]) end; a[l]^[c]:=vali[j] end end; Close(f) end; procedure init_ok; begin for i:=0 to 9 do for ch:='a' to 'z' do ok[i,ch]:=0; ok[1,'i']:=1; ok[1,'j']:=1; ok[2,'a']:=1; ok[2,'b']:=1; ok[2,'c']:=1; ok[3,'d']:=1; ok[3,'e']:=1; ok[3,'f']:=1; ok[4,'g']:=1; ok[4,'h']:=1; ok[5,'k']:=1; ok[5,'l']:=1; ok[6,'m']:=1; ok[6,'n']:=1; ok[7,'p']:=1; ok[7,'r']:=1; ok[7,'s']:=1; ok[8,'t']:=1; ok[8,'u']:=1; ok[8,'v']:=1; ok[9,'w']:=1; ok[9,'x']:=1; ok[9,'y']:=1; ok[0,'o']:=1; ok[0,'q']:=1; ok[0,'z']:=1 end; procedure init; begin p:=Length(numar); for i:=1 to p do Val(numar[i],nr[i],er); v[0]:=0; for i:=1 to p do v[i]:=Maxint end; procedure work; begin for i:=0 to p-1 do if v[i]<>maxint then begin l:=1; c:=0; for j:=1 to n do begin sl:=l; sc:=c; if i+lng^[j]<=p then if v[i]+1<v[i+lng^[j]] then begin test:=true; for k:=1 to lng^[j] do begin c:=c+1; if c>cmax then begin l:=l+1; c:=1; end; if ok[nr[i+k], a[l]^[c]]=0 then begin test:=false; k:=lng^[j] end; end; if test then begin v[i+lng^[j]]:=v[i]+1; used[i+lng^[j]]:=j; jump[i+lng^[j]]:=i end end; l:=sl; c:=sc+lng^[j]; if c>cmax then begin l:=l+1; c:=c-cmax end end end end; procedure imposibil; begin if v[p]=maxint then begin Assign(f,no); Rewrite(f); Writeln(f,'No solution.'); Close(f); Halt end end; procedure reconst; begin i:=p; cate:=0; while i>0 do begin cate:=cate+1; use[cate]:=used[i]; i:=jump[i]; end; for i:=1 to cate do cuse[i]:=use[i]; for i:=1 to cate-1 do for j:=i+1 to cate do if cuse[i]>cuse[j] then begin aux:=cuse[i]; cuse[i]:=cuse[j]; cuse[j]:=aux end; l:=1; c:=0; k:=1; for i:=1 to n do if k>cate then i:=n else begin if i=cuse[k] then begin stl[k]:=l; stc[k]:=c; k:=k+1 end; c:=c+lng^[i]; if c>cmax then begin l:=l+1; c:=c-cmax end end; for i:=1 to cate do if cuse[i]=cuse[i-1] then begin stl[i]:=stl[i-1]; stc[i]:=stc[i-1] end end; procedure scrie; begin Assign(f,no); Rewrite(f); for i:=cate downto 1 do begin for j:=1 to cate do if use[i]=cuse[j] then k:=j; l:=stl[k]; c:=stc[k]; for h:=1 to lng^[use[i]] do begin c:=c+1; if c>cmax then begin l:=l+1; c:=1 end; Write(f,a[l]^[c]) end; Write(f,' ') end; Writeln(f); Close(f) end; Begin load; init_ok; init; work; imposibil; reconst; scrie End. [cuprins] |