Why WA?
Posted by
Evgeny 10 Jan 2003 04:16
label Metka;
const maxn = 220;
var
p,i,j,k,n,m,pos,num,d: integer;
s: string;
a,res,b: array[1..2*maxn] of integer;
max,buf,bufer: array[1..2*maxn] of byte;
fl: boolean;
procedure calc;
var i,j,k,n,m: integer;
begin
for i := maxn-20 downto 1 do begin
if max[i] <> 0 then break;
end;
for j := 1 to i-1 do begin
res[j] := 9*j;
end;
for j := 1 to i+10 do begin
res[j+1] := res[j+1] + res[j] div 10;
res[j] := res[j] mod 10;
end;
dec(max[i]);
fillchar(a,sizeof(a),0);
for j := 1 to i do begin
a[j] := max[j]*i;
end;
for j := 1 to i+10 do begin
a[j+1] := a[j+1] + a[j] div 10;
a[j] := a[j] mod 10;
end;
for j := 1 to i+10 do begin
b[j+1] := b[j+1] + (a[j] + res[j]) div 10;
b[j] := b[j] + (a[j] + res[j]) mod 10;
end;
res := b;
res[1] := res[1] +2- pos;
j := 1;
while res[j] >= 10 do begin
res[j+1] := res[j+1] + res[j] div 10;
res[j] := res[j] mod 10;
inc(j);
end;
end;
function srav: boolean;
var i:integer;
begin
srav := false;
for i := maxn downto 1 do begin
if max[i] > bufer[i] then begin
srav := true;
exit;
end;
if max[i] < bufer[i] then break;
end;
end;
function test(st,fin: integer): boolean;
var i: integer;
begin
if st >= 1 then begin
if buf[fin-st+1] = 0 then begin
test := false;
exit;
end;
end;
test := true;
for i := st to fin do begin
if (i<1) or (i>n) then continue;
if buf[fin-i+1] <> a[i] then begin
test := false;
exit;
end;
end;
end;
procedure incr;
var p : integer;
begin
p := 1;
inc(buf[p]);
while buf[p]>=10 do begin
buf[p] := buf[p] mod 10;
buf[p+1] := buf[p+1] +1;
inc(p);
end;
if p > j-i+1 then inc(d);
end;
procedure decr;
var p,i : integer;
begin
p := 1;
while buf[p]=0 do begin
inc(p)
end;
dec(buf[p]);
for i := p-1 downto 1 do buf[i] := 9;
end;
begin
readln(s);
fl := true;
fillchar(max,sizeof(max),9);
for i := 1 to length(s) do begin
val(s[i],a[i],k);
if a[i] <> 0 then fl := false;
end;
if fl then begin
fillchar(max,sizeof(max),0);
max[length(s)+1] := 1;
goto Metka;
end;
n := length(s);
for i := 1 to n do begin
for j := i to n do begin
if a[i] = 0 then break;
d := 0;
fillchar(buf,sizeof(buf),0);
fillchar(bufer,sizeof(bufer),0);
for k := j downto i do begin
buf[j-k+1] := a[k];
bufer[j-k+1] := a[k];
end;
p := i;
fl := true;
repeat
p := p-j+i-1+d;
decr;
if not test(p,p+j-i+d) then begin
fl := false;
break;
end;
until p < 1;
if fl then begin
repeat
p := p+j-i+1+d;
incr;
if not test(p,p+j-i+d) then begin
fl := false;
break;
end;
until p > n;
end;
if fl then begin
if srav then begin
max := bufer;
pos := i;
end;
end;
end;
end;
for i := 2 to n do begin
for j := i-1 downto 1 do begin
if a[i]=0 then break;
d := 0;
fillchar(buf,sizeof(buf),0);
fillchar(bufer,sizeof(bufer),0);
for k := i-1 downto j do begin
buf[i-k] := a[k];
bufer[i-k] := a[k];
end;
for k := n downto i do begin
bufer[i-j+1+n-k] := a[k];
buf[i-j+1+n-k] := a[k];
end;
p := i;
fl := true;
num := n-j+1;
repeat
p := p-num;
if not test(p,p+num-1) then begin
fl := false;
break;
end;
decr;
until p < 1;
if fl then begin
repeat
p := p+num;
incr;
if not t