Cod sursa(job #465748)

Utilizator tibi9876Marin Tiberiu tibi9876 Data 25 iunie 2010 12:52:27
Problema Minim2 Scor 0
Compilator fpc Status done
Runda Stelele Informaticii 2010, gimnaziu si clasa a IX-a, Ziua 1 Marime 0.75 kb
var a:array[1..100000] of real;
    n,nr,i,j:longint;
    x,y,ar,b,aux:real;
    ok:boolean;
begin
assign(input,'minim2.in');reset(input);
assign(output,'minim2.out');rewrite(output);
readln(n);x:=0;
for i:=1 to n do begin read(a[i]);x:=x+a[i];a[i]:=-(a[i]);end;
readln(ar,b,y);
nr:=0;
for i:=1 to n do a[i]:=a[i]*(1-ar);
repeat
ok:=true;
for i:=1 to n-1 do
if a[i]>a[i+1] then
begin
aux:=a[i];
a[i]:=a[i+1];
a[i+1]:=aux;
ok:=false;
end;
until ok;
while (x>y) and (abs(x-y)>=0.000001) do
begin
inc(nr);
x:=x-abs(a[1]);
if a[1]<0 then
begin
a[1]:=abs(a[1]);
a[1]:=a[1]/(1-ar)*(1-b);
end
else a[1]:=a[i]*b;
j:=1;
while abs(a[j])<abs(a[j+1]) do
begin
aux:=a[j];
a[j]:=a[j+1];
a[j+1]:=aux;
inc(j);
end;
end;
write(nr+1);
end.