Cod sursa(job #36866)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 24 martie 2007 11:16:26
Problema Elimin Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.86 kb
type vector=array[1..15] of 0..1;
var f,g:text;
    i,j,n,m,r,c,k:integer;
    a:array[1..52,1..52] of integer;
    ok:boolean;
    x:vector;
    max,q:longint;
    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 adauga(var x:vector);
     var j:integer;
     begin
       if x[n]=0 then x[n]:=1
         else
           begin
             j:=n;
             while x[j]=1 do
                begin
                  x[j]:=0;
                  dec(j);
                end;
             x[j]:=1;
           end;
     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;
for i:=1 to n do x[i]:=0;
ok:=true;
while ok do
   begin
 adauga(x);
 for i:=1 to n do write(x[i],' ');
q:=0; for i:=1 to n do if x[i]=1 then inc(q);
if q=n then ok:=false
   else if q=r then
      begin
        for i:=1 to m do v[i]:=0;
     for i:=1 to n do
        if x[i]=0 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;
    end;
assign(g,'elimin.out');
rewrite(g);
writeln(g,max);
close(g);
end.