Cod sursa(job #14549)

Utilizator CezarMocanCezar Mocan CezarMocan Data 9 februarie 2007 12:11:23
Problema Elimin Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.13 kb
TYPE INTARRAY=array[0..800]of longint;
var s,st:array[0..25]of longint;
    v:array[0..20,0..7500]of longint;
    x:intarray;
    i,j,n,m,r,c,stot,max,aux:longint;

procedure Merge (var A: INTARRAY; p, q, r: integer);
var i, j, k: integer;
var B: INTARRAY;
begin { Merge }
  i := p;
  j := q + 1;
  k := p;
  while ((i <= q) and (j <= r)) do
    begin
      if (A[i] < A[j])
         then begin
                B[k] := A[i];
                i := i + 1;
              end
         else begin
                B[k] := A[j];
                j := j + 1;
              end;
      k := k + 1;
    end;
    while (i <= q) do
      begin
        B[k] := A[i];
        k := k + 1;
        i := i + 1;
      end;
    while (j <= r) do
      begin
        B[k] := A[j];
        k := k + 1;
        j := j + 1;
      end;
    for k := p to r do A[k] := B[k];
end;

procedure MergeSort (var A: INTARRAY; p, r: integer);
var q: integer;
begin { MergeSort }
  if (p < r) then
               begin
                 q := (p + r) div 2;
                 MergeSort (A, p, q);
                 MergeSort (A, q + 1, r);
                 Merge (A, p, q, r);
               end;
end;

procedure back(k,no:longint);
var i,j,ss,min,nr:longint;
    ok:boolean;
begin
if k=no then
        begin
        nr:=0;
        for i:=1 to no do
                if st[i]=1 then
                        begin
                        inc(nr);
                        s[nr]:=i;
                        end;
        if nr=r then
                begin
                ss:=stot;
                for i:=1 to n do
                        x[i]:=v[0,i];
                for i:=1 to nr do
                        for j:=1 to n do
                                dec(x[j],v[s[i],j]);
                for i:=1 to nr do
                        ss:=ss-v[s[i],0];
                mergesort(x,1,n);
                for i:=1 to c do
                        ss:=ss-x[i];
                if ss>max then
                        max:=ss;
                end
        end
else
        for i:=1 downto 0 do
                begin
                st[k+1]:=i;
                back(k+1,no);
                end;
end;

begin
assign(input,'elimin.in');reset(input);
assign(output,'elimin.out');rewrite(output);
readln(m,n,r,c);
if n<m then
        begin
        aux:=n;
        n:=m;
        m:=aux;
        aux:=r;
        r:=c;
        c:=aux;
        for i:=1 to n do
                for j:=1 to m do
                        begin
                        read(v[j,i]);
                        inc(v[j,0],v[j,i]);
                        stot:=stot+v[j,i];
                        end;
        for i:=1 to m do
                for j:=1 to n do
                        inc(v[0,j],v[i,j]);
        end
else begin
for i:=1 to m do
        for j:=1 to n do
                begin
                read(v[i,j]);
                inc(v[i,0],v[i,j]);
                stot:=stot+v[i,j];
                end;
for i:=1 to n do
        for j:=1 to m do
                inc(v[0,i],v[j,i]);
end;
back(0,m);
writeln(max);
close(input);close(output);
end.