Why i get wrong answer? Help me, please.
Posted by
Misha_W 11 Mar 2002 21:59
type mas=array[1..2,0..1005] of longint;
var a:mas;b:char;code:integer;m,i,j,n:longint;
procedure rasp(q,q1:byte;var a:mas);
var i:word;
begin
if q=0 then for i:=1 to a[1,0] do write(a[1,i])
else begin
for i:=1 to q-1 do
write(a[1,i]);
write(q1);
for i:=q to a[1,0] do
write(a[1,i]);
end;
writeln;
end;
begin
readln(n);
repeat
i:=0;
m:=0;
repeat
read(b);
if (b='1')or(b='0') then begin
inc(i);
val(b,a[1,i],code);
end;
if b='1' then m:=m+i;
until eoln;
if i>0 then begin
readln;
a[1,0]:=i;
a[2,i+1]:=0;
for i:=a[1,0] downto 1 do
a[2,i]:=a[1,i]+a[2,i+1];
if a[1,0]=n then
if m mod (n+1)=0 then rasp(0,0,a)
else begin
i:=0;
while a[1,(m mod (n+1))-i*(n+1)]<>1 do
inc(i);
a[1,(m mod (n+1))+i*(n+1)]:=0;
rasp(0,0,a);
end
else
if a[1,0]<n then
if a[2,1]>=((n+1)-(m mod (n+1))) mod (n+1) then begin
i:=0;
repeat
inc(i);
until a[2,i]=((n+1)-(m mod (n+1))) mod (n+1);
rasp(i,0,a);
end
else begin
i:=0;
repeat
inc(i);
until (a[2,i]+i+m) mod (n+1)=0;
rasp(i,1,a);
end
else begin
i:=0;
repeat
inc(i);
until (m-a[1,i]*i-a[2,i]+a[1,i]) mod (n+1)=0;
for j:=1 to i-1 do
write(a[1,j]);
for j:=i+1 to a[1,0] do
write(a[1,j]);
writeln;
end;
end;
until eof;
end.