Cod sursa(job #12595)

Utilizator andrei_infoMirestean Andrei andrei_info Data 4 februarie 2007 14:35:20
Problema Elimin Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.85 kb
//infoarena elimin preoni 2007 runda 1

var a:array[1..15,1..600] of integer;
    suma:array[1..600] of longint;
    x:array[1..15] of integer;
    n,m,r,c,s:integer;
    rez:longint;

procedure citire;
var i,j,aux:integer;
begin
assign(input,'elimin.in'); reset(input);
readln(m,n,r,c);
if m <= 15 then
        begin
        for i:=1 to m do
                   for j:=1 to n do
                        read(a[i,j]);
        end
else
        begin
        aux:=r; r:=c; c:=aux;
        for j:=1 to m do
                for i:=1 to n do
                        read(a[i,j]);
        aux:=m; m:=n; n:=aux;
        end;
close(input);
end;

procedure Sort(l, r: Integer);
var
  i, j :integer;
  x, y: longint;
begin
  i := l; j := r; x := suma[(l+r) DIV 2];
  repeat
    while suma[i] < x do i := i + 1;
    while x < suma[j] do j := j - 1;
    if i <= j then
    begin
      y := suma[i]; suma[i] := suma[j]; suma[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;


procedure calc;
var i,j:integer;
    aux,rr:longint;
begin
fillchar(suma,sizeof(suma),0);
for i:=1 to m do
         for j:=1 to n do
                if x[i] = 1 then suma[j]:=suma[j]+a[i,j];

sort(1,n);
rr:=0;
for i:=n downto c+1 do
        rr:=rr+suma[i];
if rr > rez then rez:=rr;

end;



procedure back(k:byte);
var i:integer;
begin
if k = m+1 then
        begin
   if s = r then
        calc
        end
else
        for i:=0 to 1 do
                begin
                x[k]:=i;
                if i = 0 then inc(s);
                if s <= r then
                         back(k+1);
                if i = 0 then dec(s);
                end;
end;


begin
citire;
back(1);
assign(output,'elimin.out'); rewrite(output);
writeln(rez);
close(output);

end.