Cod sursa(job #1569713)

Utilizator mirelabocsabocsa mirela mirelabocsa Data 15 ianuarie 2016 21:00:07
Problema Elimin Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.75 kb
program mire;
var f,g:text;
    {a:array of array of integer;
    x:array of integer;
    v,y:array of longint;}
    a:array[0..900,0..900] of integer;
    x:array[0..900] of integer;
    v,y:array[0..900] of longint;
    n,m,c,r:integer;
    max:longint;
procedure citire;
var i,j:integer;
   s:longint;
begin
   assign(f,'elimin.in'); reset(f);
   assign(g,'elimin.out'); rewrite(g);
     readln(f,n,m,r,c);
   {if n>=m then
    begin
     setlength(a,n+5,m+5);
     setlength(x,c+10);
      setlength(v,n+10);
      setlength(y,n+10);
      for i:=1 to n do
        v[i]:=0;
    end
   else
    begin
       setlength(a,m+5,n+5);
      setlength(x,c+10);
      setlength(v,m+10);
      setlength(y,m+10);
      for i:=1 to m do
         v[i]:=0;
    end; }
    if (n>=m) then
     begin
     for i:=1 to n do
      begin
      for j:=1 to m do
        begin
                read(f,a[i,j]);
                v[i]:=v[i]+a[i,j];
        end;
      end;
     end
      else
       begin
           for i:=1 to n do
            begin
                for j:=1 to m do
                  begin
                        read(f,a[j,i]);
                        v[j]:=v[j]+a[j,i]
                  end;
             end;
        s:=n;
        n:=m;
        m:=s;
        s:=r;
        r:=c;
        c:=s;
       end;
   close(f);
end;
function pivot(st,dr:integer):integer;
var i,j,di,dj,aux:integer;
begin
   i:=st;
   j:=dr;
   di:=0;
   dj:=1;
   while i < j do
      begin
      if y[i] < y[j] then
         begin
         aux:=y[i];
         y[i]:=y[j];
         y[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 suma(k:integer);
var i:integer;
    s:longint;
begin
  s:=0;
  y:=v;
 sort(1,k);
 for i:=1 to n-r do
   s:=s+y[i];
  if s>max then
    max:=s;
   for i:=1 to n do
       v[i]:=v[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
            v[i]:=v[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
                  v[i]:=v[i]+a[i,x[k]];
         end;
end;

begin
 citire;
 max:=0;

        bkt;
        writeln(g,max);
 close(g);
end.