Cod sursa(job #35909)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 22 martie 2007 18:03:06
Problema Elimin Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.26 kb
type vector=array[1..15] of byte;
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;
begin
assign(f,'elimin.in');
reset(f);
readln(f,n,m,r,c);
if m<=15 then
  begin
     k:=n;
           n:=m;
           m:=k;
           k:=c;
           c:=r;
           r:=k;
  end;
 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;
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;
assign(g,'elimin.out');
rewrite(g);
writeln(g,max);
close(g);
end.