Cod sursa(job #155467)

Utilizator adrianraduleaRadulea Adrian adrianradulea Data 11 martie 2008 22:35:47
Problema Transport Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.02 kb
var f,g:text;   
    a:array[1..16000] of integer;   
    n,k,i,l,ul:integer;   
    s,sm,capacitate,li,ls,m:longint;   
    max:real;   
    ok,ok1:boolean;   
begin  
assign(f,'transport.in'); reset(f);   
assign(g,'transport.out'); rewrite(g);   
read(f,n,k);   
max:=0; s:=0;   
for i:=1 to n do begin  
  read(f,a[i]);   
  if a[i]>max then max:=a[i];   
  s:=s+a[i];   
end;   
if s/k>max then max:=s/k;   
if trunc(max)<>max then max:=trunc(max)+1;   
li:=trunc(max); ls:=trunc(s*2/k);   
ok:=false; ok1:=false;   
while (not(ok and not ok1)) and (li<=ls) do begin  
  ok:=ok1;   
  if m mod 2=0 then m:=(li+ls) div 2 else m:=(li+ls) div 2+1; l:=1; sm:=0;   
  for i:=1 to n do  
    if (sm+a[i]<=m) then sm:=sm+a[i]   
                   else begin  
                     sm:=a[i];   
                     inc(l);   
                   end;   
  if l<=k then begin  
    capacitate:=m;   
    ls:=m-1;   
    ok1:=true;   
  end else li:=m+1;   
end;   
write(g,capacitate);   
close(g);   
end.