Cod sursa(job #119818)

Utilizator mari_anaMariana Gheorghe mari_ana Data 3 ianuarie 2008 13:34:48
Problema Elimin Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.73 kb
program elimin;
type vector=array[1..525] of integer;
     matrice=array[1..525,1..525]of integer;
var st,st2:vector;
    f:text;
    suma:array[1..525] of int64;
    m,n,r,c,i1,i2:integer;
    mat:matrice;
    sol:int64;


procedure coloana;
function valid(k:integer):boolean;
var i,j:integer;
begin
j:=0;
for i:=1 to k do
  if st2[i]=1 then
    j:=j+1;
if j<=c then
  valid:=true
else
  valid:=false
end;

function minim:integer;
var j:integer;
    min:int64;
begin
min:=1 shl 60;
for j:=1 to m do
  if (st[j]=0) and (suma[j]<min) then
    begin
    minim:=j;
    min:=suma[j]
    end
end;

procedure solutie;
var i,j:integer;
    s:int64;
begin
for i:=1 to m do
  begin
  suma[i]:=0;
  st[i]:=0;
  for j:=1 to n do
    if st2[j]=0 then
      suma[i]:=suma[i]+mat[i,j]
  end;
for j:=1 to r do
  st[minim]:=1;

s:=0;
for j:=1 to m do
  if st[j]=0 then
   s:=s+suma[j];
if s>sol then
  sol:=s
end;


function ok(k:integer):boolean;
var i,j:integer;
begin
j:=0;
for i:=1 to k do
  if st2[i]=1 then
    j:=j+1;
if j=c then
  ok:=true
else
  ok:=false
end;

procedure back(k:integer);
var i:integer;
begin
if k<=n then
  for i:=1 downto 0 do
    begin
    st2[k]:=i;
    if valid(k) then
      if (k=n) and ok(k)then
        solutie
      else
        back(k+1)
    end
end;

begin
back(1)
end;

procedure linie;
function valid(k:integer):boolean;
var i,j:integer;
begin
j:=0;
for i:=1 to k do
  if st[i]=1 then
    j:=j+1;
if j<=r then
  valid:=true
else
  valid:=false
end;

function minim:integer;
var j:integer;
    min:int64;
begin
min:=1 shl 60;
for j:=1 to n do
  if (st2[j]=0) and (suma[j]<min) then
    begin
    minim:=j;
    min:=suma[j]
    end
end;

procedure solutie;
var i,j:integer;
    s:int64;
begin
for j:=1 to n do
  begin
  suma[j]:=0;
  st2[j]:=0;
  for i:=1 to m do
    if st[i]=0 then
      suma[j]:=suma[j]+mat[i,j]
  end;
for j:=1 to c do
  st2[minim]:=1;

s:=0;
for j:=1 to n do
  if st2[j]=0 then
   s:=s+suma[j];
if s>sol then
  sol:=s
end;


function ok(k:integer):boolean;
var i,j:integer;
begin
j:=0;
for i:=1 to k do
  if st[i]=1 then
    j:=j+1;
if j=r then
  ok:=true
else
  ok:=false
end;

procedure back(k:integer);
var i:integer;
begin
if k<=m then
  for i:=1 downto 0 do
    begin
    st[k]:=i;
    if valid(k) then
      if (k=m) and ok(k)then
        solutie
      else
        back(k+1)
    end
end;

begin
back(1)
end;

begin
assign(f,'elimin.in'); reset(f);
readln(f,m,n,r,c);
for i1:=1 to m do
  for i2:=1 to n do
    read(f,mat[i1,i2]);
close(f);

sol:=0;
if m<=n then
  linie
else
  coloana;

assign(f,'elimin.out'); rewrite(f);
writeln(f,sol);
close(f)
end.