Cod sursa(job #465697)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 25 iunie 2010 12:08:51
Problema Minim2 Scor 0
Compilator fpc Status done
Runda Stelele Informaticii 2010, gimnaziu si clasa a IX-a, Ziua 1 Marime 3.65 kb
program alex;
var f:text;
    viz:array[0..100001]of 0..1;
    c:array[0..100001]of real;
    s,max,a,b,rd,r1,r2:real;
    n,i,l,r,m,nr:longint;
    e:boolean;
procedure sort(l,r:longint);
var i,j:longint;
    mij,z:real;
begin
i:=l;j:=r;mij:=c[(i+j)div 2];
repeat
while c[i]<mij do
      i:=i+1;
while mij<c[j] do
      j:=j-1;
if i<=j then begin
             z:=c[i];
             c[i]:=c[j];
             c[j]:=z;
             i:=i+1;
             j:=j-1;
             end;
until(i>j);
if i<r then sort(i,r);
if l<j then sort(l,j);
end;
begin
assign(f,'minim2.in');reset(f);
readln(f,n);
s:=0;
for i:=1 to n do
    begin
    read(f,c[i]);
    viz[i]:=0;
    s:=s+c[i];
    end;
readln(f);
readln(f,a,b,rd);
close(f);
assign(f,'minim2.out');rewrite(f);
if s<rd then writeln(f,0)
        else begin
             sort(1,n);
             s:=s-c[n];
             max:=c[n]*a;
             n:=n-1;
             s:=s+max;
             l:=1;r:=n;
             e:=false;
             while(l<r)and(e=false)do
                 begin
                 m:=(l+r)div 2;
                 if max>c[m] then r:=m-1
                             else e:=true;

                 end;
             if e=false then begin
                             n:=n+1;
                             c[n]:=max;
                             viz[n]:=1;
                             end
                             else begin
             while max<c[m] do
                   m:=m-1;
             m:=m+1;
             for i:=n+1 downto m+1 do
                 c[i]:=c[i-1];
             c[m]:=max;
             viz[m]:=1;
             n:=n+1;
                                end;
             if s<rd then writeln(f,1)
                     else begin
                          nr:=1;
                          repeat
                          nr:=nr+1;
                          if viz[n]=1 then r1:=c[n]*b
                                      else r1:=c[n]*a;
                          if viz[n-1]=1 then r2:=c[n-1]*b
                                        else r2:=c[n-1]*a;
                          if abs(c[n]-r1)>abs(c[n-1]-r2)then begin
                                        s:=s-c[n];
                                        max:=r1;
                                        s:=s+r1;
                                        n:=n-1;
                                        end
                                   else begin
                                        s:=s-c[n-1];
                                        max:=r2;
                                        s:=s+r2;
                                        c[n-1]:=c[n];c[n]:=0;
                                        n:=n-1;
                                        end;
                             l:=1;r:=n;
                             e:=false;
             while(l<r)and(e=false)do
                 begin
                 m:=(l+r)div 2;
                 if max>c[m] then r:=m-1
                             else e:=true;

                 end;
                if e=false then begin
                             n:=n+1;
                             c[n]:=max;
                             viz[n]:=1;
                             end
                             else begin
                while max<c[m] do
                   m:=m-1;
                m:=m+1;
             for i:=n+1 downto m+1 do
                 c[i]:=c[i-1];
             c[m]:=max;
             viz[m]:=1;
             n:=n+1;
                                end;
                          until(s<rd);
                          writeln(f,nr);
                          end;
             end;
close(f);
end.