Cod sursa(job #1570440)

Utilizator Stefan.Andras Stefan Stefan. Data 16 ianuarie 2016 15:41:42
Problema Elimin Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.49 kb
program eliminare;
const Nmax  = 1005;
var f, g:text;
    a:array[1..Nmax, 1..Nmax] of integer;
    x:array[1..Nmax] of integer;
    vsum, vaux:array[1..Nmax] of longint;
    n, m, r, c, aux, i, j:integer;
    max:longint;
    bufin, bufout:array[1..1 shl 17] of byte;

function pivot(st,dr:longint):integer;
var i,j,di,dj:integer;
    aux:longint;
begin
   i := st; j := dr;
   di := 0; dj := 1;
   while i < j do
      begin
      if vaux[i] < vaux[j] then
         begin
         aux := vaux[i];
         vaux[i] := vaux[j];
         vaux[j] := aux;
         aux := di;
         di := dj;
         dj := aux;
         end;
      i := i + di;
      j := j - dj;
      end;
   pivot := i;
end;
procedure sort(st,dr:integer);
var p:integer;
begin
   if st < dr then
       begin
       p:=pivot(st,dr);
       sort(st,p-1);
       sort(p+1,dr);
       end;
end;


procedure citire;
var i, j:integer;
begin
   readln(f,n,m,r,c);
   if n >= m then
      begin
         for i := 1 to n do
            for j := 1 to m do
               begin
                  read(f, a[i, j]);
                  vsum[i] := vsum[i] + a[i, j];
               end;

      end
   else
      begin
          for i := 1 to n do
             for j := 1 to m do
                begin
                   read(f, a[j, i]);
                   vsum[j] := vsum[j] + a[j, i];
                end;
          aux := n;
          n := m;
          m := aux;
          aux := r;
          r := c;
          c := aux;
      end;
end;

procedure suma(k:integer);
var i:integer;
    s:longint;
begin
   s:=0;
   vaux:=vsum; sort(1,n);
   for i := 1 to n-r do s := s + vaux[i];
   if s > max then max:=s;
   for i := 1 to n do vsum[i] := vsum[i] + a[i, x[k]];
end;

procedure bkt;
var k,i:integer;
begin
   k := 1; x[k] := 0;
   while k > 0 do
      if x[k] < m then
        begin
          x[k] := x[k]+1;
          for i := 1 to n do vsum[i] := vsum[i] - a[i, x[k]];
          if k = c then suma(k)
              else
              begin
                 k := k+1;
                 x[k] := x[k-1];
              end;
         end
         else
         begin
            k := k-1;
            for i := 1 to n do vsum[i] := vsum[i] + a[i,x[k]];
         end;
end;

begin
   assign(f, 'elimin.in'); reset(f);
   assign(g, 'elimin.out'); rewrite(g);
   settextbuf(f, bufin); settextbuf(f, bufout);
   citire();
   max := 0; bkt();
   writeln(g, max);
   close(f); close(g);
end.