Help!
Here's my programm:
var s:array [1..100] of char;
r:array [1..100,1..100,1..100] of char;
l:array [1..100,1..100] of byte;
n,i,j,z,k,a,b:integer;
bool:boolean;
function f (i:byte):byte;
begin
if (i>=10) and (i<100) then f:=4 else if i=100 then f:=5 else f:=3;
end;
begin
i:=1; fillchar (l,sizeof (l),0);
while not eoln do begin Read (s[i]); inc (i); end;
n:=i-1;
for j:=1 to 4 do
for i:=1 to n-j+1 do begin
for z:=i to i+j-1 do r[i,j,z-i+1]:=s[z];
l[i,j]:=j;
end;
for j:=5 to n do
for i:=1 to n-j+1 do begin
a:=0;
for z:=1 to j-1 do
if (l[i,j]>l[i,z]+l[i+z,j-z]) or (l[i,j]=0) then
begin
l[i,j]:=l[i,z]+l[i+z,j-z];
a:=z;
end;
b:=0;
for z:=2 to j do
if j mod z=0 then
begin
bool:=true;
for k:=i to i-1+j-j div z do if s[k]<>s[k+j div z] then begin bool:=false; break; end;
if bool then if l[i,j]>=f(z)+l[i,j div z] then
begin
l[i,j]:=f(z)+l[i,j div z];
b:=z;
end;
end;
if b=0 then
begin
for z:=1 to l[i,a] do
r[i,j,z]:=r[i,a,z];
for z:=1 to l[i+a,j-a]
do r[i,j,z+l[i,a]]:=r[i+a,j-a,z];
end else
begin
if b<10 then begin
r[i,j,1]:=chr (b+ord ('0'));
r[i,j,2]:='(';
for z:=1 to l[i,j div b] do r[i,j,z+2]:=r[i,j div b,z];
r[i,j,l[i,j div b]+3]:=')';
end else if b<100 then begin
r[i,j,1]:=chr (b div 10+ord ('0'));
r[i,j,2]:=chr (b mod 10+ord ('0'));
r[i,j,3]:='(';
for z:=1 to l[i,j div b] do r[i,j,z+3]:=r[i,j div b,z];
r[i,j,l[i,j div b]+4]:=')';
end else begin
r[i,j,1]:='1';
r[i,j,2]:='0';
r[i,j,3]:='0';
r[i,j,4]:='(';
for z:=1 to l[i,j div b] do r[i,j,z+4]:=r[i,j div b,z];
r[i,j,l[i,j div b]+5]:=')';
end;
end;
end;
for i:=1 to l[1,n] do write (r[1,n,i]);
end.
It gets ML on test 20.
