Cod sursa(job #112990)

Utilizator cezar_pirvuCezar Pirvu cezar_pirvu Data 8 decembrie 2007 13:04:17
Problema Multimi2 Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.52 kb
var a:array[1..64300]of byte;
   f,g:text;
   nr1,dif,nr :integer;
   n,i:longint;
begin
  assign(f,'multimi2.in');
  reset(f);
  assign(g,'multimi2.out');
  rewrite(g);
  readln(f,n);
  if n<64300 then begin
  for i:=1 to n do
     readln(f,a[i]);
  i:=n;
  while i-4>=0 do begin
               a[i]:=1;
               a[i-1]:=2;
               a[i-2]:=2;
               a[i-3]:=1;
               i:=i-4;
               end;
  nr1:=(n div 4)*2;
  case i of
    0:dif:=0;
    1:begin
        a[1]:=1;
        dif:=1;
        nr1:=nr+1;
        end;
    2:begin
        a[1]:=1;
        a[2]:=2;
        dif:=1;
        nr1:=nr+1;
        end;
    3:begin
        a[1]:=1;
        a[2]:=2;
        a[3]:=2;
        dif:=0;
        nr1:=nr+2;
        end;end;
   writeln(g,dif);
   writeln(g,nr1);
   for i:=1 to n do
      if a[i]=1 then write(g,i,' ');
      writeln(g);
      writeln(g,n-nr1);
   for i:=1 to n do
      if a[i]=2 then write(g,i,' ');
   end
   else
   begin
     case n mod 4 of
     0:begin
       dif:=0;nr:=(n div 4)*2;
       end;
     1:begin
       dif:=1;nr:=(n div 4)*2+1;
       end;
     2:begin
       dif:=1;nr:=(n div 4)*2+1;
       end;
     3:begin
       dif:=0;nr:=(n div 4)*2+2;
       end;
     end;
     writeln(g,dif);
     writeln(g,nr);

     for i:= 1 to nr1 do
     write(g,' ');
     writeln(g);
     writeln(g);
     writeln(g,n-nr1);
     for i:=nr+1 to n do
     write(g,i,' ');
     end;
     close(f);
     close(g);
     end.