Cod sursa(job #2378)

Utilizator bigsarpeadrian bigsarpe Data 17 decembrie 2006 09:05:02
Problema Balans Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.77 kb
{$q-,r-,s-,d-,i-}
const maxn=300;oo=100*1000*1000;
var t:Text;
   S:array[0..maxn,0..maxn]of int64;
   V:array[0..maxn]of int64;
   Q:array[0..maxn]of longint;
   sol,p1,p2,n,m,r,c,i,j,step,go,N2,M2,qlo,qhi:longint;cat:int64;return:boolean;
   function works(val:longint):boolean;
   begin
      return:=false;p1:=0;{GO:=N+R;}
      while p1<N do
      begin
         p2:=p1+r;go:=p1+n;
         while p2<=go do
         begin
            cat:=int64(p2-p1)*val;qlo:=1;qhi:=0;
            for i:=1 to C-1 do V[i]:=v[i-1]+S[p2,i]-S[p1,i]-cat;
            for i:=C to M2 do
            begin
               V[i]:=v[i-1]+S[p2,i]-S[p1,i]-cat;
               while (qlo<=qhi)and(Q[qlo]<i-m)do inc(qlo);
               while (qlo<=qhi)and(V[Q[qhi]]>=V[i-c])do dec(qhi);
               inc(qhi);Q[qhi]:=i-c;
               if (V[i]>=V[Q[qlo]]) then
               begin p1:=oo;p2:=oo;return:=true;break;end;
            end;inc(p2);
         end;inc(p1);
      end;
      works:=return;
   end;
 {  var t1:longint;t2:longint absolute $0:$046c;}
begin
{   t1:=t2;             }
   assign(t,'balans.in');reset(T);readln(t,n,m,r,c);n2:=n*2;m2:=m*2-1;
   for i:=1to N do
   begin
      for j:=1 to M do
      begin
         read(t,p1);S[i,j]:=p1*1000;
         S[i,j+m]:=S[i,j];S[i+n,j]:=S[i,j];S[i+n,j+m]:=S[i,j];
      end;readln(T);
   end;close(T);
   for i:=1 to N*2 do for j:=1 to M*2 do inc(s[i,j],s[i-1,j]);
   step:=1;while step<oo do step:=step*2;
   while step>0 do
   begin
      if (step+sol<=oo)and works(step+sol) then inc(sol,step);
      step:=step div 2;
   end;
   assign(t,'balans.out');rewrite(T);write(t,sol div 1000,'.');sol:=sol mod 1000;
   writeln(t,sol div 100,(sol div 10)mod 10,sol mod 10);close(T);
{   write((T2-t1)/18.2:0:6,' ');}
end.