Cod sursa(job #112997)

Utilizator gusi007Gusoi Constantin Codrut gusi007 Data 8 decembrie 2007 13:31:42
Problema Multimi2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.78 kb
var i,n,dif,nr1:byte;
    f,g:text;
    a:array[1..64000] of byte;
begin
     assign(f,'multimi2.in');
     assign(g,'multimi2.out');
     reset(f);
     rewrite(g);
     read(f,n);
     if n<65000 then begin
     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:=nr1+1;
                  end;
          2: begin
             a[1]:=1;
             a[2]:=2;
             dif:=2;
             nr1:=nr1+1;
             end;
          3: begin
             a[1]:=1;
             a[2]:=1;
             a[3]:=2;
             dif:=0;
             nr1:=nr1+2;
             end;
end;
end
   else begin
        case n mod 4 of
             0: begin
                dif:=0;
                nr1:=(n div 4)*2;
                end;
             1,2:  begin
                dif:=1;
                nr1:=(n div 4)*2+1;
                end;
             3:  begin
                dif:=0;
                nr1:=(n div 4)*2+2;
                end;
                end;
    writeln(g,dif);
    writeln(g,nr1);
    i:=n;
    while i-4>=0 do begin
          write(g,i,' ',i-3,' ');
          i:=i-4;
          end;
    case i of
         1,2: write (g,1,' ');
         3: write(g,1,' ',2);
         end;
         writeln(g);
         writeln(g,n-nr1);
         i:=n;
         while i-4>=0 do begin
               write(g,i-1,' ',i-2,' ');
               i:=i-4;
               end;
         case i of
              2: write(g,2);
              3: write(g,3);
end;
    close(f);
    close(g);
end;
end.