Cod sursa(job #465709)

Utilizator nbibestNeagu Bogdan Ioan nbibest Data 25 iunie 2010 12:24:42
Problema Minim2 Scor 0
Compilator fpc Status done
Runda Stelele Informaticii 2010, gimnaziu si clasa a IX-a, Ziua 1 Marime 0.87 kb
var     i,n,l,ll,p,k:longint;
        v,w:array[0..100000]of real;
        a,b,r,s,d:real;
        ok:boolean;
begin
assign(input,'minim2.in');
assign(output,'minim2.out');

reset(input);
rewrite(output);

readln(n);
for i:=1 to n do
read(v[i]);
read(a,b,r);
close(input);

for i:=1 to n do
begin
        w[i]:=a;
        s:=s+v[i];
end;

for i:=1 to n do
begin
        if v[i]>v[l] then
        begin
                ll:=l;
                l:=i;
        end;
end;

ok:=false;
repeat


for i:=1 to n do
if (i<>l)and(v[i]>v[ll]) then
ll:=i;

while (s>=r)and(abs(r-s)>0.000001)and(v[l]-v[l]*w[l]>=v[ll]-v[ll]*w[ll]) do
begin
        d:=v[l]-v[l]*w[l];
        v[l]:=v[l]*w[l];
        if w[l]=a then
        w[l]:=b;
        inc(p);
        s:=s-d;

end;

l:=ll;
ll:=0;

until (s<r)or(abs(r-s)<0.000001);


write(p);
close(output);

end.