Hi
What will be answer of
4
1000
both 0000 and 1001 are correct?
or there is an order to change 1 with 0 or 0 with 1?

i decompose problem to 3 way:
add
Change
Delete

and they all are correct... but still WA :((

more info.
b[i] means number of '1' not back of a[i];
(i saved the string of input in boolean array:a);
....
procedure writt, writes from x to y of input...
and
i dont think i forgot anything...
please help me everyhow you can

Thanks again
Aidin_n7
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Var
  n,s,k,i             :integer;
  t                   :char;
  a                   :array[1..1001] of boolean;
  b                   :array[1..1001] of integer;

procedure writt(x,y:integer);
Var
  i                   :byte;
begin
  for i:=x to y do
    if a[i] then write(1)
      else write(0);
end;

procedure add;
Var
  i,p                 :integer;
begin
  if k=0 then begin
    writt(1,s);
    writeln(0);
  end
  else
  begin
    b[n]:=0;
    for i:=n-1 downto 1 do
      b[i]:=b[i+1]+ord(a[i]);
    if k+b[1]>=(n+1) then {add 0}
    begin
      p:=0;
      repeat inc(p);
      until (k+b[p]) mod (n+1)=0;
      writt(1,p-1);
      write(0);
      writt(p,s);
      writeln;
    end
    else
    begin
      p:=0;
      repeat inc(p);
      until (k+p+b[p]) mod (n+1)=0;
      writt(1,p-1);
      write(1);
      writt(p,s);
      writeln;
    end;
  end;
end;

procedure chn;
begin
  if k=0 then
  begin
    writt(1,n);
    writeln;
  end
  else
    if a[k] then
    begin
      writt(1,k-1);
      write(0);
      writt(k+1,n);
      writeln;
    end
    else
    begin
      writt(1,n-k);
      write(1);
      writt(n-k+2,n);
      writeln;
    end;
end;

procedure del;
Var
  i,p                 :integer;
begin
  if k=0 then
  begin
    writt(1,n);
    writeln;
  end
  else
  begin
    b[n+1]:=ord(a[n+1]);
    for i:=n downto 1 do
      b[i]:=b[i+1]+ord(a[i]);
    p:=0;
    repeat inc(p);
    until (k-b[p]-(p-1)*(ord(a[p]))) mod (n+1)=0;
    writt(1,p-1);
    writt(p+1,n+1);
    writeln;
  end;
end;

begin
  readln(n);
  while not eof do
  begin
    s:=0;
    while not eoln and not eof do
    begin
      read(t);
      if (ord(t)=48) or (ord(t)=49) then begin
        inc(s);
        a[s]:=ord(t)=49;
      end;
    end;
    k:=0;
    for i:=1 to s do
      if a[i] then
        k:=(k+i) mod (n+1);
    if s =n-1 then
      add
      else if s=n then
        chn
        else if s=n+1 then
          del;
    readln;
  end;
end.

~~~~~~~~~~~~~~~~~

Var
  n,s,k,i             :integer;
  t                   :char;
  a                   :array[1..1001] of boolean;
  b                   :array[1..1001] of integer;

procedure writt(x,y:integer);
Var
  i                   :byte;
begin
  for i:=x to y do
    if a[i] then write(1)
      else write(0);
end;

procedure add;
Var
  i,p                 :integer;
begin
  if k=0 then begin
    writt(1,s);
    writeln(0);
  end
  else
  begin
    b[n]:=0;
    for i:=n-1 downto 1 do
      b[i]:=b[i+1]+ord(a[i]);
    if k+b[1]>=(n+1) then {add 0}
    begin
      p:=0;
      repeat inc(p);
      until (k+b[p]) mod (n+1)=0;
      writt(1,p-1);
      write(0);
      writt(p,s);
      writeln;
    end
    else
    begin
      p:=0;
      repeat inc(p);
      until (k+p+b[p]) mod (n+1)=0;
      writt(1,p-1);
      write(1);
      writt(p,s);
      writeln;
    end;
  end;
end;

procedure chn;
begin
  if k=0 then
  begin
    writt(1,n);
    writeln;
  end
  else
    if a[k] then
    begin
      writt(1,k-1);
      write(0);
      writt(k+1,n);
      writeln;
    end
    else
    begin
      writt(1,n-k);
      write(1);
      writt(n-k+2,n);
      writeln;
    end;
end;

procedure del;
Var
  i,p                 :integer;
begin
  if k=0 then
  begin
    writt(1,n);
    writeln;
  end
  else
  begin
    b[n+1]:=ord(a[n+1]);
    for i:=n downto 1 do
      b[i]:=b[i+1]+ord(a[i]);
    p:=0;
    repeat inc(p);
    until (k-b[p]-(p-1)*(ord(a[p]))) mod (n+1)=0;
    writt(1,p-1);
    writt(p+1,n+1);
    writeln;
  end;
end;

begin
  readln(n);
  while not eof do
  begin
    s:=0;
    while not eoln and not eof do
    begin
      read(t);
      if (ord(t)=48) or (ord(t)=49) then begin
        inc(s);
        a[s]:=ord(t)=49;
      end;
    end;
    k:=0;
    for i:=1 to s do
      if a[i] then
        k:=(k+i) mod (n+1);
    if s =n-1 then
      add
      else if s=n then
        chn
        else if s=n+1 then
          del;
    readln;
  end;
end.