Cod sursa(job #37814)

Utilizator adalLica Adela adal Data 25 martie 2007 12:43:13
Problema Elimin 2 Scor 20
Compilator fpc Status done
Runda preONI 2007, Runda 4, Clasa a 10-a Marime 1.27 kb
program elimin2;
var f,g:text; ok:boolean;
  i,n,j,max,y,m,x:longint;
  a,b:array[0..2000] of char;
  v:array[0..2000,0..2000] of integer;

function min(x,y:longint):longint;
begin
 min:=x;
 if min>y then min:=y;
end;
begin
 assign(f,'elimin2.in'); reset(f);
 assign(g,'elimin2.out'); rewrite(g);
 n:=0;
 while not(eoln(f)) do begin
  inc(n);
  read(f,a[n]);
 end;
 for i:=0 to n do begin v[0,i]:=i; v[i,0]:=i; end;
 for i:=1 to n do
   for j:=1 to n-i+1 do
     if (a[i]=a[n-j+1]) then begin
        v[i,j]:=v[i-1,j-1];
        if (a[i]='0') and(v[i,j]=i+j-2) then v[i,j]:=min(v[i-1,j],v[i,j-1])+1;
     end
                      else v[i,j]:=min(v[i-1,j],v[i,j-1])+1;
  max:=n;
 for i:=1 to n do
  if v[i,n-i+1]<=max then begin
         max:=v[i,n-i+1]; y:=i;
   end;

 i:=y; j:=n-i+1;
 if i+j>n then begin inc(m); ok:=false; b[m]:=a[i]; dec(i); dec(j); end;
 while (i<>0) and (j<>0) do begin
   if a[i]=a[n-j+1] then begin inc(m); b[m]:=a[i]; dec(i); dec(j); end
   else begin
      if (v[i,j-1]<v[i-1,j]) or((a[i]<a[n-j+1]) and (v[i,j-1]=v[i-1,j])) then dec(j)
      else dec(i);
  end;
 end;
 if ok=false then x:=2 else x:=1;
 while b[m]='0' do dec(m);
 for i:=m downto x do write(g,b[i]);
 for i:=1 to m do write(g,b[i]);
 close(f); close(g);
end.