Cod sursa(job #296468)

Utilizator lsorin_94Lodoaba Sorin lsorin_94 Data 4 aprilie 2009 20:27:04
Problema Multimi2 Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.21 kb
program multimi2;
type vec=array [1..500000] of longint;
var i,j,n,na,nb,S,sa,sb,mid,k,count,suma:longint;
    t,f:text;
    a,b,v:vec;
    par:boolean;
begin
  assign(f,'multimi2.in');
  reset(f);
  assign(t,'multimi2.out');
  rewrite(t);
  read(f,n);
  par:=false;
  if n mod 2=0
    then
      begin
        par:=true;
        for i:=1 to n div 2 do
          begin
            if (i mod 2=0) and not (i=n div 2)
              then
                begin
                  na:=na+1;
                  a[na]:=i;
                  sa:=sa+a[na];
                  na:=na+1;
                  a[na]:=n-i+1;
                  sa:=sa+a[na];
                end;
            if (i mod 2=1) and not(i=n div 2)
              then
                begin
                  nb:=nb+1;
                  b[nb]:=i;
                  sb:=sb+b[nb];
                  nb:=nb+1;
                  b[nb]:=n-i+1;
                  sb:=sb+b[nb];
                end;
            if i=n div 2
              then
                begin
                  if sa>sb
                   then
                     begin
                       if i<i+1
                         then
                           begin
                             nb:=nb+1;
                             b[nb]:=i+1;
                             na:=na+1;
                             a[na]:=i;
                           end
                         else
                           begin
                             nb:=nb+1;
                             b[nb]:=i;
                             na:=na+1;
                             a[na]:=i+1;
                           end;
                     end
                   else
                     begin
                       if i<i+1
                         then
                           begin
                             na:=na+1;
                             a[na]:=i+1;
                             nb:=nb+1;
                             b[nb]:=i;
                           end
                         else
                           begin
                             na:=na+1;
                             a[na]:=i;
                             nb:=nb+1;
                             b[nb]:=i+1;
                           end;
                     end;
                end;
          end;
      end
    else 
      begin
        writeln(t,abs((suma-mid)-mid));
   suma:=0;
   k:=n;
   count:=0;
    while suma<mid do
      begin
         if suma+k<=mid then
                  begin
                     v[k]:=1;
                     suma:=suma+k;
                     count:=count+1;
                  end;
          k:=k-1;
      end;
   writeln(t,n-count);
   for i:=1 to n do
      if v[i]=0 then  write(t,i,' ');
   writeln(t);
   writeln(t,count);
   for i:=1 to n do
      if v[i]=1 then  write(t,i,' ');
      end;
  if par
    then
      begin
        S:=1;
        writeln(t,S);
        writeln(t,na);
        for i:=1 to na do
          write(t,a[i],' ');
        writeln(t);
        writeln(t,nb);
        for i:=1 to nb do
          write(t,b[i],' ');
      end;
  (*-------------------------------------------*)
  close(f);
  close(t);
end.