Cod sursa(job #15097)

Utilizator floringh06Florin Ghesu floringh06 Data 10 februarie 2007 18:22:46
Problema Elimin Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.89 kb
var fi,fo:text;
    i,j,n,m,ct,r,c,max,aux,k:longint;
    d,int:array[1..550] of integer;
    a:array[1..550,1..550] of integer;



 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 heapsort(n:integer);
  begin
   for i:=1 to n do
    begin
     j:=i;
     while (j div 2<>0) and (d[j div 2]>d[j]) do
      begin
        aux:=d[j div 2];
        d[j div 2]:=d[j];
        d[j]:=aux;
        j:=j div 2;
      end;
    end;
   i:=n;
   while i>1 do
    begin
     aux:=d[1];
     d[1]:=d[i];
     d[i]:=aux;
     dec(i);
     j:=1;
     while (1>0) do
      begin
       k:=2*j;
       if (k>i) then  break;
       if (k+1<=i) and (d[k+1]<d[k]) then inc(k);
       if d[j]<=d[k] then break;

       aux:=d[j];
       d[j]:=d[k];
       d[k]:=aux;
       j:=k;
      end;
     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

         d:=int;
         ct:=0;
         for j:=1 to m do
          begin
           if ct>r then break;
           if ((1 shl (j-1)) and i)<>0 then
             begin
               for k:=1 to n do
               if a[j,k]>0 then d[k]:=d[k]-a[j,k]
                 else d[k]:=d[k]+a[j,k];
               inc(ct);
             end;
          end;
         if ct=r then
           begin
            heapsort(n);
            ss:=0;
            for k:=1 to n-c do
              ss:=ss+d[k];
            if ss>max then max:=ss;
           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

         d:=int;
         ct:=0;
         for j:=1 to n do
          begin
           if ct>c then break;
           if ((1 shl (j-1)) and i)<>0 then
             begin
               for k:=1 to m do
                 if a[k,j]>0 then d[k]:=d[k]-a[k,j]
                    else d[k]:=d[k]+a[k,j];
               inc(ct);
             end;
          end;
         if ct=c then
           begin
            heapsort(m);
            ss:=0;
            for k:=1 to m-r do
              ss:=ss+d[k];
            if ss>max then max:=ss;
           end;
         end;
       end;







begin
  assign(fi,'elimin.in'); reset(fi);
  assign(fo,'elimin.out'); rewrite(fo);
  readln(fi,m,n,r,c);
  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.