Cod sursa(job #119142)

Utilizator ProtomanAndrei Purice Protoman Data 29 decembrie 2007 18:33:44
Problema Elimin Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.81 kb
var f1,f2:text;
    a,b:array[1..1000,1..1000] of integer;
    i,j,s,m,n,l,c,aux,max,x,p:longint;
    vc,st:array[1..1000] of longint;

procedure line;
var i,j:longint;
begin
        for i:=1 to m do
                for j:=1 to n do
                        if vc[j]=0 then
                                inc(st[i],a[i,j]);
        for i:=1 to m-1 do
                for j:=i+1 to m do
                        if st[i]>st[j] then
                        begin
                                aux:=st[i];
                                st[i]:=st[j];
                                st[j]:=aux;
                        end;
        s:=0;
        for i:=m downto l+1 do
                s:=s+st[i];
        for i:=m downto 1 do
                st[i]:=0;
end;

begin
        assign(f1,'elimin.in');
        reset(f1);
        assign(f2,'elimin.out');
        rewrite(f2);
        read(f1,m,n,l,c);
        for i:=1 to m do
                for j:=1 to n do
                begin
                        read(f1,a[i,j]);
                        b[j,i]:=a[i,j];
                end;
        if n>m then
        begin
                a:=b;
                aux:=n;
                n:=m;
                m:=aux;
        end;
        for i:=0 to 1 shl n-1 do
        begin
                x:=i;
                j:=0;
                p:=0;
                while x>0 do
                begin
                        inc(j);
                        vc[j]:=x mod 2;
                        x:=x div 2;
                        if vc[j]=1 then
                                inc(p);
                end;
                if p=c then
                        line;
                if s>max then
                        max:=s;
        end;
        write(f2,max);
        close(f1);
        close(f2);
end.