Cod sursa(job #119162)

Utilizator ProtomanAndrei Purice Protoman Data 29 decembrie 2007 19:01:35
Problema Elimin Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.95 kb
var f1,f2:text;
    a:array[1..1000,1..1000] of integer;
    i,j,s,m,n,l,c,aux,max,x,p,dimh,h:longint;
    vc,st:array[1..1000] of longint;

procedure repair(i:longint);
var l,r,max,aux:longint;
begin
        l:=2*i;
        r:=l+1;
        max:=i;
        if (l<=dimh)and(st[l]>st[max]) then
                max:=l;
        if (r<=dimh)and(st[r]>st[max]) then
                max:=r;
        if max<>i then
        begin
                aux:=st[i];
                st[i]:=st[max];
                st[max]:=aux;
                repair(max);
        end;
end;

procedure buildheap(h:longint);
var i:longint;
begin
        for i:=h div 2 downto 1 do
                repair(i);
end;

procedure heapsort(h:longint);
var i,aux:longint;
begin
        buildheap(h);
        for i:=h downto 2 do
        begin
                aux:=st[1];
                st[1]:=st[i];
                st[i]:=aux;
                dec(dimh);
                repair(1);
        end;
end;

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;
        dimh:=m;
        h:=m;
        heapsort(h);
        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
                        read(f1,a[i,j]);
        if n>m then
        begin
                for i:=1 to m do
                        for j:=i to n do
                        begin
                                aux:=a[i,j];
                                a[i,j]:=a[j,i];
                                a[j,i]:=aux;
                        end;
                aux:=n;
                n:=m;
                m:=aux;
                aux:=l;
                l:=c;
                c:=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.