Cod sursa(job #62246)

Utilizator cezar305Mr. Noname cezar305 Data 22 mai 2007 09:20:37
Problema Transport Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.29 kb
var x,sa,ok1,ok2,nr,m,i,s,ind,k,n,c,max:longint;
    f1,f2:text;
    a:array[1..16000] of longint;

procedure transport(nr:longint);
var i:longint;
begin
        ind:=1;
        x:=1;
        sa:=0;
        for i:=1 to n do
        begin
        if sa+a[i]<=nr then sa:=sa+a[i]
                else if sa+a[i]>nr then
                begin
                        sa:=a[i];
                        inc(ind);
                end;
        end;
        if ind>k then x:=0;
end;

procedure search(li,ls:longint);
begin
        m:=(li+ls) div 2;
        transport(m);
        ok1:=x;
        transport(m-1);
        ok2:=x;
        if (ok1=1)and(ok2=0) then c:=m
                else if li<ls then
                        if (ok1=1)and(ok2=1) then search(li,m-1)
                                else if ok1=0 then search(m+1,ls);
end;


begin
        assign(f1,'transport.in');
        reset(f1);
        assign(f2,'transport.out');
        rewrite(f2);
        read(f1,n,k);
        if k>n then k:=n;
        max:=-maxlongint;
        for i:=1 to n do
        begin
                read(f1,a[i]);
                s:=s+a[i];
                if a[i]>max then max:=a[i];
        end;
        search(max,s);
        writeln(f2,c);
        close(f1);
        close(f2);
end.