Cod sursa(job #11365)

Utilizator gurneySachelarie Bogdan gurney Data 31 ianuarie 2007 14:48:58
Problema Elimin Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.39 kb
program elimin;
  const
    fin='elimin.in';
    fout='elimin.out';
  type
    matr=array[1..15,1..4000] of integer;
  var
    a,b:matr;
    smax,s:longint;
    st:array[0..15] of integer;
    ss:array[1..4000] of longint;
    m,n,r,c,i,j,k:longint;

function part(st,dr:integer):integer;
  var
    i,j,x:longint;
  begin
    i:=st-1;j:=dr+1;
    x:=ss[st];
    while i<j do
      begin
        repeat
          dec(j);
        until ss[j]<=x;
        repeat
          inc(i);
        until ss[i]>=x;
        if i<j then
          begin
            ss[i]:=ss[i] xor ss[j];
            ss[j]:=ss[i] xor ss[j];
            ss[i]:=ss[i] xor ss[j];
          end;
      end;
    part:=j;
  end;

procedure sort(st,dr:integer);
  var
    p:integer;
  begin
    if st<dr then
      begin
        p:=part(st,dr);
        sort(st,p);
        sort(p+1,dr);
      end;
  end;

function sum:longint;
  var
    i,j:integer;
    s:longint;
      begin
        for i:=1 to m do
          for j:=1 to n do
            b[i,j]:=a[i,j];
        s:=0;
        for i:=1 to r do
          for j:=1 to n do
            begin
              b[st[i],j]:=0;
            end;
        for j:=1 to n do
          begin
            ss[j]:=0;
            for i:=1 to m do
              inc(ss[j],b[i,j]);
            inc(s,ss[j]);
          end;
        sort(1,n);
        for i:=1 to c do
          dec(s,ss[i]);
        sum:=s;
      end;

procedure back(x:integer);
  var
    i:integer;
    begin
      if x=r+1 then
        begin
          s:=sum;
          if s>smax then
            smax:=s;
        end
      else
        begin
          for i:=st[x-1]+1 to m do
            begin
              st[x]:=i;
              back(x+1);
              st[x]:=0;
            end;
        end;
    end;

begin
  assign(input,fin);
    reset(input);
    readln(m,n,r,c);
    st[0]:=0;
    if m>15 then
      begin
        for i:=1 to m do
          for j:=1 to n do
            read(a[j,i]);
        m:=m xor n;
        n:=m xor n;
        m:=m xor n;
        r:=r xor c;
        c:=r xor c;
        r:=r xor c;
      end
    else
      begin
        for i:=1 to m do
          for j:=1 to n do
            read(a[i,j]);
      end;
  close(input);
  assign(output,fout);
    rewrite(output);
    smax:=0;
    back(1);
    writeln(smax);
  close(output);
end.