Cod sursa(job #277123)

Utilizator MBlueGheorghevici Mihai MBlue Data 11 martie 2009 15:18:38
Problema Transport Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.11 kb
var i,n,k,max,min : integer;
    s : array[1..16000] of integer;
    f : text;
procedure citeste;
begin
     read(f,n,k);
     for i := 1 to n do begin
         read(f,s[i]);
         if s[i] > min then min := s[i];
         max := max + s[i];
     end;
end;
function verificare(m:integer):boolean;
var x,c : integer;
begin
     x := 1;
     c := 0;
     for i := 1 to n do begin
         if (c + s[i]) <= m then begin
            c := c + s[i];
         end
         else begin
              c := s[i];
              x := x +1;
         end;
     end;
     if x <= k then verificare := true
     else verificare := false;
end;
function cbin(p,q : integer):integer;
var m,cmin : integer;
begin
     cmin := q
     while p <= q do begin
           m := (p+q) div 2;
           if verificare(m) then begin
              cmin := m;
              q := m -1;
           end
           else p := m +1;
     end;
     cbin := cmin ;
end;
begin
     assign(f,'transport.in');reset(f);
     citeste; close(f);
     assign(f,'transport.out');rewrite(f);
     write(f,cbin(min,max));
     close(f);
end.