Can anybody make my prog fast?
Strangely enough, it takes less than 1 sec to run the 'Complete number' part, whose time complexity appears to be O(n^2), but nearly 4 sec to run the 'No complete number' part, whose time complexity seems to be O(n). I doubt it's the function 'connect' that makes it slow. Can anyone help me?
program ural1165;
var
a,k,s,t:string;
l,i,j:byte;
function max(a,b:byte):byte;
begin
if a>b then max:=a else max:=b;
end;
function min(a,b:byte):byte;
begin
if a<b then min:=a else min:=b;
end;
function minstr(a,b:string):string;
var
i:byte;
begin
if length(a)<length(b) then begin
minstr:=a;exit;
end
else if length(a)>length(b) then begin
minstr:=b;exit;
end
else
for i:=length(a) downto 1 do
if a[i]<b[i] then begin
minstr:=a;exit;
end
else if a[i]>b[i] then begin
minstr:=b;exit;
end;
minstr:=a;
end;
function serial(l:byte;c:char):string;
var
s:string;
i:byte;
begin
s:='';
for i:=1 to l do
s:=s+c;
serial:=s;
end;
function reverse(a:string):string;
var
i:byte;
s:string;
begin
s:='';
for i:=length(a) downto 1 do
s:=s+a[i];
reverse:=s;
end;
function connect(a,b:string):string;
var
i:byte;
begin
i:=min(length(a),length(b))-1;
while i>0 do begin
if copy(a,1,i)=copy(b,length(b)-i+1,i) then begin
connect:=copy(b,1,length(b)-i)+a;
exit;
end;
dec(i);
end;
connect:=b+a;
end;
function inc1(a:string):string;
var
l,i:byte;
begin
l:=length(a);
i:=1;
repeat
if a[i]<'9' then break;
inc(i);
until i>l;
if i>l then
inc1:=serial(l,'0')+'1'
else begin
inc(a[i]);
while i>1 do begin
dec(i);
a[i]:='0';
end;
inc1:=a;
end;
end;
function dif(a,b:string):string;
var
l,i:byte;
begin
l:=length(a);
while length(b)<l do b:=b+'0';
for i:=1 to l do
dec(a[i],ord(b[i])-48);
for i:=1 to l-1 do
if a[i]<'0' then begin
inc(a[i],10);
dec(a[i+1]);
end;
while a[length(a)]='0' do
delete(a,length(a),1);
dif:=a;
end;
function product(a:string;b:byte):string;
var
s:string;
i:byte;
p:integer;
begin
s:='';p:=0;
for i:=1 to length(a) do begin
inc(p,(ord(a[i])-48)*b);
s:=s+chr(48+p mod 10);
p:=p div 10;
end;
while p>0 do begin
s:=s+chr(48+p mod 10);
p:=p div 10;
end;
product:=s;
end;
function position(x:string):string;
var
s:string;
l,i:byte;
begin
l:=length(x);
s:=inc1(product(dif(x,'1'),l));
for i:=1 to l-1 do
s:=dif(s,product(serial(i-1,'0')+'9',l-i));
position:=s;
end;
function expand(x:string;p:byte):boolean;
var
t:string;
q:byte;
begin
expand:=false;q:=p;
{Expand front}
t:=x;
while p>0 do begin
if t='1' then exit;
t:=dif(t,'1');
if length(t)>p then t:=copy(t,1,p);
if t<>copy(a,l-p+1,length(t)) then exit;
dec(p,length(t));
end;
{Expand rear}
t:=x;
p:=l-length(x)-q;
while p>0 do begin
t:=inc1(t);
if length(t)>p then t:=copy(t,length(t)-p+1,p);
if t<>copy(a,p-length(t)+1,length(t)) then exit;
dec(p,length(t));
end;
expand:=true;
end;
begin
assign(input,'1165.in');reset(input);
readln(a);
l:=length(a);
if a=serial(l,'0') then
k:=inc1(position(a+'1'))
else begin
a:=reverse(a);
k:=serial(255,'9');
{Complete number}
for i:=l downto 1 do
if a[i]>'0' then
for j:=i downto 1 do
if expand(copy(a,j,i-j+1),l-i) then begin
str(l-i,t);
k:=minstr(k,dif(position(copy(a,j,i-j+1)),reverse(t)));
end;
{No complete number}
for i:=l-1 downto 1 do
if a[i]>'0' then begin
s:=copy(a,i+1,l-i);
s:=inc1(s);
if length(s)>l-i then delete(s,l-i+1,1);
str(l-i,t);
k:=minstr(k,dif(position(connect(copy(a,1,i),s)),reverse(t)));
end;
end;
writeln(reverse(k));
end.