link:http://www.mediafire.com/?5n0qnn3tt4h35dl

program bt;
const fi='bt.inp';
fo='bt.out';
var l:array[0..100,0..100] of integer;
x,z:string;
n,i:integer;
f:text;
procedure doc;
begin
assign(f,fi);
reset(f);
Readln(f,x);
close(f);
end;
procedure khoitao;
var i,j:integer;
begin
assign(f,fo);
rewrite(f);
n:=length(x);
fillchar(l,sizeof(l),0);
for i:=1 to n do
l[i,i]:=1;
for i:=2 to n do
for j:=1 to i-1 do
l[i,j]:=0;
z:='';
end;
function max(a,b:integer):integer;
var t:integer;
begin
t:=a;
if t<b then t:=b;
max:=t;
end;
procedure xdbang;
var i,j:integer;
begin
for j:=2 to n do
for i:=j-1 downto 1 do
begin
if x[i]=x[j] then l[i,j]:=l[i+1,j-1]+2
else
l[i,j]:=max(l[i+1,j],l[i,j-1]);
end;
end;
procedure truyvet;
var i,j:integer;
begin
i:=1;j:=n;
while l[i,j]<>0 do
begin
if x[i]=x[j] then
begin
z:=z+x[i];
inc(i);
dec(j);
end
else
begin
if l[i,j]=l[i+1,j] then inc(i)
else if l[i,j]=l[i,j-1] then dec(j);
end;
end;
end;
begin
doc;
khoitao;
xdbang;
truyvet;
write(f,z);
if length(z)<>1 then
begin
if l[1,n] mod 2=1 then
for i:=length(z)-1 downto 1 do
write(f,z[i])
else
for i:=length(z) downto 1 do
write(f,z[i]);
end;
writeln(f);
write(f,l[1,n]);
close(f);
end.