LQDDIV - Phân tập

Tác giả: RR

Ngôn ngữ: Pascal

//Written by RR
{$R+,Q+}
{$Mode objfpc}
{$inline on}
uses math;
const
  FINP          =       '';
  FOUT          =       '';
  MAXN          =       33;
  MAXL          =       100111;
  sign          :       array[0..1] of longint=(-1,1);

var
  f1,f2         :       text;
  n,res,sum     :       longint;
  a             :       array[1..MAXN] of longint;
  x,e           :       array[0..1,1..MAXL] of longint;
  sl            :       array[0..1] of longint;

procedure openF;
    begin
      assign(f1,FINP); reset(f1);
      assign(f2,FOUT); rewrite(f2);
    end;

procedure closeF;
    begin
      close(f1);
      close(f2);
    end;

procedure sort(u,l,r:longint);
    var
      i,j,mid,tmp:longint;
    begin
      i:=l; j:=r; mid:=x[u,l+random(r-l+1)];
      repeat
        while x[u,i]<mid do inc(i);
        while x[u,j]>mid do dec(j);
        if i<=j then
          begin
            tmp:=x[u,i];
            x[u,i]:=x[u,j];
            x[u,j]:=tmp;
            inc(i); dec(j);
          end;
      until i>j;
      if i<r then sort(u,i,r);
      if l<j then sort(u,l,j);
    end;

procedure duyet(i,gh,k:longint);
    var
      j:longint;
    begin
      for j:=0 to 1 do
        begin
          sum:=sum+sign[j]*a[i];
          if i<gh then duyet(i+1,gh,k)
          else
            begin
              inc(sl[k]);
              x[k,sl[k]]:=sum;
            end;
          sum:=sum-sign[j]*a[i];
        end;
    end;

procedure solve;
    var
      i,j,tmp,res,count:longint;
    begin
      sum:=0;
      duyet(1,n>>1,0);
      sort(0,1,sl[0]);

      sum:=0;
      duyet(n>>1+1,n,1);
      sort(1,1,sl[1]);

      e[0,1]:=1; tmp:=1;
      for i:=2 to sl[0] do
        if x[0,i]>x[0,tmp] then
          begin
            inc(tmp);
            x[0,tmp]:=x[0,i];
            e[0,tmp]:=1;
          end
        else inc(e[0,tmp]);
      sl[0]:=tmp;

      e[1,1]:=1; tmp:=1;
      for i:=2 to sl[1] do
        if x[1,i]>x[1,tmp] then
          begin
            inc(tmp);
            x[1,tmp]:=x[1,i];
            e[1,tmp]:=1;
          end
        else inc(e[1,tmp]);
      sl[1]:=tmp;

      res:=high(longint); count:=0;
      j:=sl[1];
      for i:=1 to sl[0] do
        begin
          while (j>1) and (abs(x[1,j-1]+x[0,i])<abs(x[1,j]+x[0,i])) do dec(j);
          tmp:=abs(x[1,j]+x[0,i]);
          if tmp<res then
            begin
              res:=tmp;
              count:=e[0,i]*e[1,j];
            end
          else if tmp=res then inc(count,e[0,i]*e[1,j]);

          if j>1 then
            begin
              tmp:=abs(x[1,j-1]+x[0,i]);
              if tmp<res then
                begin
                  res:=tmp;
                  count:=e[0,i]*e[1,j-1];
                end
              else if tmp=res then inc(count,e[0,i]*e[1,j-1]);
            end;
        end;
      writeln(f2,res,' ',count div 2);
    end;

procedure inp;
    var
      i:longint;
    begin
      read(f1,n);
      for i:=1 to n do
        read(f1,a[i]);
    end;

begin
  openF;
  inp;
  solve;
  closeF;
end.

Download