Cod sursa(job #20954)

Utilizator alex_mircescuAlex Mircescu alex_mircescu Data 22 februarie 2007 17:47:03
Problema Elimin Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.53 kb
var i,dpn,k,j,sumf,u,n,m,vb1,c,el,max,ec,o:longint;
    v:array[1..32] of longint;
    a,mtc:array[1..4000,1..4000] of integer;

procedure binar;
var aux:longint;
begin
c:=0;
aux:=k;
repeat
inc(c);
v[c]:=aux mod 2;
aux:=aux div 2;
until aux=0;
end;

procedure elimin_linii;
var min,ipr,jpr,suma:longint;
begin
min:=maxlongint;
suma:=0;
for ipr:=1 to n do
  begin
   vb1:=0;
   suma:=0;
   if a[ipr,1]=32001 then vb1:=1;
   if vb1=0 then
     begin
      for jpr:=1 to m do
        if a[ipr,jpr]<>-1 then suma:=suma+a[ipr,jpr];
      if suma<min then begin min:=suma; o:=ipr; end;
     end;
  end;
for ipr:=1 to m do
  a[o,ipr]:=32001;
end;

begin
assign(input,'elimin.in');
assign(output,'elimin.out');
reset(input);
rewrite(output);
readln(n,m,el,ec);
for i:=1 to n do for j:=1 to m do begin read(a[i,j]); mtc[i,j]:=a[i,j]; end;
{if m>n then
  begin
   z:=m;
   m:=n;
   n:=z;
   z:=el;
   el:=ec;
   ec:=z;
   for}
dpn:=1 shl m;
for k:=1 to dpn-1 do
  begin
   binar;
   sumf:=0;
   u:=0;
   for i:=1 to c do
     if v[i]=1 then inc(u);
   if u=ec then
     begin
      for i:=1 to c do
        if v[i]=1 then
          for j:=1 to n do
            a[j,i]:=-1;
      for i:=1 to el do
        elimin_linii;
      for i:=1 to n do
        for j:=1 to m do
          begin
           if (a[i,j]<>32001) and (a[i,j]<>-1) then sumf:=sumf+a[i,j];
           a[i,j]:=mtc[i,j];
          end;
      if sumf>max then max:=sumf;
     end;
  end;
write(max);
close(input);
close(output);
end.