Cod sursa(job #14339)

Utilizator floringh06Florin Ghesu floringh06 Data 8 februarie 2007 19:57:28
Problema Elimin Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.18 kb
var fi,fo:text;
    i,j,n,m,ct,r,c,max,p1,p2:longint;
    d,int:array[1..1000] of integer;
    a:array[1..1000,1..1000] of integer;


 procedure calc(x,y:integer);
   var i,j,p:integer;
     begin
      p:=1;
      for i:=1 to y do
        p:=p*2;
      p1:=p;
      for i:=2 to x do
        p1:=p1+p div 2;

     end;

 procedure sumlin(x:integer);
  var sum,j:integer;
   begin
    sum:=0;
    for j:=1 to n do
      sum:=sum+a[x,j];
    d[x]:=sum;
   end;

 procedure sumcol(x:integer);
  var sum,i:integer;
   begin
    sum:=0;
    for i:=1 to m do
      sum:=sum+a[i,x];
    d[x]:=sum;
   end;

 procedure cutl(x:integer);
  var j:integer;
   begin
     for j:=1 to n do
      if a[x,j]>0 then d[j]:=d[j]-a[x,j]
        else d[j]:=d[j]+a[x,j];
      inc(ct);
   end;

 procedure cutc(x:integer);
   var i:integer;
    begin
     for i:=1 to m do
      if a[i,x]>0 then d[i]:=d[i]-a[i,x]
        else d[i]:=d[i]+a[i,x];
      inc(ct);
    end;

 function part(st,dr:longint):longint;
   var p,i,j,aux:longint;
       sens:integer;
    begin

      p := st + random(dr-st+1);
      aux:=d[st];
      d[st]:=d[p];
      d[p]:=aux;

      i:=st; j:=dr; sens:=-1;
      while i<j do
        begin
          if d[i]<d[j] then
           begin
            aux:=d[i];
            d[i]:=d[j];
            d[j]:=aux;
            sens:=-sens;
           end;
           if sens=1 then inc(i)
               else dec(j);
        end;
      part:=i;
   end;
 procedure qsort(st,dr:longint);
   var p:longint;
   begin
     if st<dr then
       begin
        p:=part(st,dr);
        qsort(st,p-1);
        qsort(p+1,dr);
       end;
   end;

  procedure gosolve;
    var i,j,k,ss:longint;
     begin

      for i:=1 to n do
        sumcol(i);
      int:=d;
      if n>=m then
      for i:=1 to (1 shl m) do
       begin
         if i>p1+1 then break;
         d:=int;
         ct:=0;
         for j:=1 to m do
           if ((1 shl (j-1)) and i)<>0 then cutl(j);
         if ct=r then
           begin
            qsort(1,n);
            ss:=0;
            for k:=1 to n-c do
              ss:=ss+d[k];
            if ss>max then max:=ss;
        //    writeln(fo,max);
           end;
       end;
       if n>=m then
         begin
          write(fo,max);
          close(fo);
          halt;
         end;
       for i:=1 to m do
        sumlin(i);
       int:=d;
       if m>n then
       for i:=1 to (1 shl n) do
        begin
         if i>p1 + 1 then break;
         d:=int;
         ct:=0;
         for j:=1 to n do
           if ((1 shl (j-1)) and i)<>0 then cutc(j);
         if ct=c then
           begin
            qsort(1,m);
            ss:=0;
            for k:=1 to m-r do
              ss:=ss+d[k];
            if ss>max then max:=ss;
           //writeln(fo,max);
           end;
         end;
       end;







begin
  assign(fi,'elimin.in'); reset(fi);
  assign(fo,'elimin.out'); rewrite(fo);
  readln(fi,m,n,r,c);
  if m<n then  calc(c,m) else
  calc(r,n);
  for i:=1 to m do
    for j:=1 to n do
       read(fi,a[i,j]);
  gosolve;
  writeln(fo,max);
close(fi);
close(fo);
end.