Cod sursa(job #75210)

Utilizator adrianraduleaRadulea Adrian adrianradulea Data 31 iulie 2007 12:31:52
Problema Transport Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.79 kb
var f,g:text;
    a:array[1..16000] of integer;
    n,k,max,i:integer;
    s,sm:longint;
    m:real;
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;
m:=s/k;
if max>=m then begin
  sm:=0;
  for i:=1 to n do
    if sm+a[i]-max<=max-sm then begin
                             sm:=sm+a[i]; if sm>max then max:=sm; end
                           else sm:=a[i];
  write(g,max); close(g);
end
else begin
  sm:=0; max:=trunc(m);
  for i:=1 to n do
    if sm+a[i]-max<=max-sm then begin
                             sm:=sm+a[i]; if sm>max then max:=sm; end
                           else sm:=a[i];
    write(g,max); close(g);
end;
end.