Cod sursa(job #308018)

Utilizator frozen62iceBLue FirE frozen62ice Data 25 aprilie 2009 20:34:20
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.2 kb
var nr,m,n,i,j,h,poz:longint;
    v,c:array[0..101] of longint;
    x,s:string;
    f,g:text;
    a:array[0..101] of string;
    ok,ok1:boolean;
begin
assign(f,'fraza.in');reset(f);
assign(g,'fraza.out');rewrite(g);
readln(f,n);
readln(f,s);
m:=0;
for i:=1 to n do begin
 readln(f,x);
 if pos(x,s)<>0 then begin
  inc(m);
  a[m]:=x;
 end;
end;
n:=m;
m:=length(s);
c[0]:=0;
for i:=1 to m do v[i]:=0;
for i:=1 to m do c[i]:=-1;
for i:=1 to m do begin
 x:=s[i];
 ok1:=false;
 for j:=1 to n do
  if a[j]=x then begin
  ok1:=true;
  break;
  end;
 if ok1 and(c[i-1]<>-1)then begin
  c[i]:=c[i-1]+1;
  v[i]:=j;
 end;
 poz:=i;
 for j:=i-1 downto 1 do begin
  x:=copy(s,j,i-j+1);
  ok:=false;
  for h:=1 to n do
   if a[h]=x then begin
    ok:=true;
    break;
   end;
  if (c[j-1]<>-1)and ok then
   if poz>j then begin
    poz:=j;
    nr:=h;
   end;
 end;
 if (c[i]=-1)and(poz<>i) then begin
  c[i]:=c[poz-1]+1;
  v[i]:=nr;
 end;
 if c[poz-1]+1<c[i] then begin
  c[i]:=c[poz-1]+1;
  v[i]:=nr;
 end;
end;
writeln(g,c[m]);
i:=m;
while i>0 do begin
 dec(i,length(a[v[i]]));
 insert(' ',s,i+1);
end;
if s[1]=' ' then delete(s,1,1);
writeln(g,s);
close(f);
close(g);
end.