Cod sursa(job #61571)

Utilizator vanila0406Ionescu Victor vanila0406 Data 19 mai 2007 21:47:37
Problema Elimin Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.13 kb
program elimin;
var vl,vc,vcl:array[1..10000] of longint;
     f,g:text;
     a:array[1..15,1..7000] of longint;
     vg:array[1..15] of longint;
     sumtot,max,m,n,r,c:longint;









procedure iofile;
var i,j,aux:longint;
begin
        assign(f,'elimin.in');
        reset(f);
        assign(g,'elimin.out');
        rewrite(g);
        sumtot:=0;
        readln(f,m,n,r,c);
        if m>n then
                begin
                        for i:=1 to m do
                                for j:=n downto 1 do
                                        read(f,a[j,i]);
                        aux:=m;
                        m:=n;
                        n:=aux;
                        aux:=r;
                        r:=c;
                        c:=aux;
                end else
                for i:=1 to m do
                        for j:=1 to n do
                                read(f,a[i,j]);
        fillchar(vl,sizeof(vl),0);
        fillchar(vc,sizeof(vc),0);
        for i:=1 to m do
                for j:=1 to n do
                        begin
                        vl[i]:=vl[i]+a[i,j];
                        vc[j]:=vc[j]+a[i,j];
                        sumtot:=sumtot+a[i,j];
                        end;
        close(f);
end;

procedure pozitie(var m:longint;p,u:longint);
var i,j,di,dj,aux:longint;
begin
        i:=p;
        j:=u;
        di:=0;
        dj:=-1;
        while i<j do
                begin
                        if vcl[i]>vcl[j] then
                                begin
                                        aux:=di;
                                        di:=-dj;
                                        dj:=-aux;
                                        aux:=vcl[i];
                                        vcl[i]:=vcl[j];
                                        vcl[j]:=aux;
                                end;
                        i:=i+di;
                        j:=j+dj;
                end;
        m:=i;
end;


procedure quick(p,u:longint);
var m:longint;
begin
        if p<u then
                begin
                        pozitie(m,p,u);
                        quick(p,m-1);
                        quick(m+1,u);
                end;
end;


procedure verif;
var sum,i,min,j:longint;
begin
        sum:=sumtot;
        for i:=1 to m do
                if vg[i]=1 then sum:=sum-vl[i];
        vcl:=vc;
        for i:=1 to n do
                for j:=1 to m do
                        if vg[j]=1 then vcl[i]:=vcl[i]-a[j,i];
        quick(1,n);
        for i:=1 to c do
                sum:=sum-vcl[i];
        if sum>max then max:=sum;
end;




procedure back(p,nr:longint);
var i:longint;
begin
        if nr=0 then verif else
                for i:=p+1 to m do
                        begin
                                vg[i]:=1;
                                back(i,nr-1);
                                vg[i]:=0;
                        end;
end;



begin
        iofile;
        fillchar(vg,sizeof(vg),0);
        max:=-maxlongint;
        back(0,r);
        writeln(g,max);
        close(g);
end.