Cod sursa(job #116286)

Utilizator dragos15Mateescu Dumitru Dragos dragos15 Data 18 decembrie 2007 13:06:42
Problema Multimi2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.97 kb
var i,s,n,nrm2,nrm1,gau,m1,m2:longint;
a:array [1..10000] of boolean;
f,g:text;
begin
assign(f,'multimi2.in');
reset(f);
assign(g,'multimi2.out');
rewrite(g);
readln(f,n);
gau:=n*(n+1) div 2;
writeln(g,n*(n+1) mod 2);
if gau mod 2 = 0 then begin
                 m1:=gau div 2;
                 m2:=gau div 2;
                 end else
                 begin
                 m1:=gau div 2 + 1 ;
                 m2:=gau div 2;
                 end;
i:=n;
nrm1:=0;
nrm2:=0;
fillchar(a,sizeof(a),false);
while m1>0 do
      if a[i]=false then begin
      m1:=m1-i;
      inc(nrm1);
      a[i]:=true;
      s:=s+i;
      end
       else
       i:=i-1;
if m1<0 then begin m1:=m1+i;
        nrm1:=nrm1-1;
        s:=s-i;
        end;
a[i]:=false;
a[m2-s]:=true;
writeln(g,nrm1);
for i:=1 to n do if a[i]=true then write(g,i,' ') else inc(nrm2);
writeln(g);
writeln(g,nrm2);
for i:=1 to n do if a[i]=false then write(g,i,' ');
close(f);
close(g);
end.