Cod sursa(job #35900)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 22 martie 2007 17:54:56
Problema Elimin Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.06 kb
type vector=array[1..15] of integer;
var f,g:text;
    i,j,n,m,r,c:integer;
    a:array[1..521,1..521] of integer;
    x:vector;
    max,q:longint;
    k:integer;
    as,ev:boolean;
    v:array[1..521] of longint;

procedure quick(s,d:integer);
    var a,b,ia:integer;
       t:longint;
    begin       a:=s;
      b:=d;
      repeat
        while v[a]<v[b] do b:=b-1;
        t:=v[a]; v[a]:=v[b]; v[b]:=t;
            a:=a+1; ia:=1;
            if a<b then
              begin
                while v[a]<v[b] do a:=a+1;
                  t:=v[a]; v[a]:=v[b]; v[b]:=t;
                  b:=b-1; ia:=0;
              end;
      until b<=a;
      if s<a-ia then quick(s,a-ia);
      if a-ia+1<d then quick(a-ia+1,d);
    end;
procedure init(var x:vector; k:integer);
    begin x[k]:=0; end;

procedure succesor(var x:vector; k:integer; var as:boolean);
      begin
          if x[k]<2 then begin as:=true; x[k]:=x[k]+1;end
           else as:=false; end;

procedure valid(var x:vector; k:integer; var ev:boolean);
    begin
      if k=n then
        begin
        q:=0;
     for i:=1 to n do if x[i]=2 then inc(q);
     if q=r then ev:=true
        else ev:=false;end else ev:=true; end;

function solutie:boolean;
   begin
     if k=n then solutie:=true
          else solutie:=false;
   end;
procedure tipar;
   begin
     for i:=1 to m do v[i]:=0;
     for i:=1 to n do
        if x[i]=1 then
          begin
            for j:=1 to m do v[j]:=v[j]+a[i,j];
          end;
     quick(1,m);
     q:=0;
     for i:=c+1 to m do q:=q+v[i];
     if q>max then max:=q;
   end;
function solutiec:boolean;
   begin
     if k=m then
       begin
     q:=0;
     for i:=1 to m do if x[i]=2 then inc(q);
     if q=c then solutiec:=true;
       end         else solutiec:=false;
   end;
procedure tiparc;
   begin
     for i:=1 to n do v[i]:=0;
     for i:=1 to m do
        if x[i]=1 then
          begin
            for j:=1 to n do v[j]:=v[j]+a[i,j];
          end;
     quick(1,n);
     q:=0;
     for i:=r+1 to n do q:=q+v[i];
     if q>max then max:=q;
   end;

begin
assign(f,'elimin.in');
reset(f);
readln(f,n,m,r,c);
for i:=1 to n do
  begin
  for j:=1 to m do read(f,a[i,j]);
     readln(f);
     end;
close(f);
max:=0;
if n<=15 then
  begin
    k:=1;
    init(x,k);
    while k>0 do
      begin
        repeat
           succesor(x,k,as);
           if as then valid(x,k,ev);
        until (not as)or(as and ev);
        if as then
           if solutie then tipar
              else begin inc(k); init(x,k);end
              else dec(k);

      end;
  end
     else if m<=15 then
        begin
          k:=1;
    init(x,k);
    while k>0 do
      begin
        repeat
           succesor(x,k,as);
           if as then valid(x,k,ev);
        until (not as)or(as and ev);
        if as then
           if solutiec then tiparc
              else begin inc(k); init(x,k);end
              else dec(k);

      end;
        end;
assign(g,'elimin.out');
rewrite(g);
writeln(g,max);
close(g);
end.