Cod sursa(job #465837)

Utilizator MihaicorneliuMihai Pojar Mihaicorneliu Data 25 iunie 2010 13:30:28
Problema Minim2 Scor 0
Compilator fpc Status done
Runda Stelele Informaticii 2010, gimnaziu si clasa a IX-a, Ziua 1 Marime 2.21 kb
program minim2;
type vector=array[1..100000] of real;
     vectb=array[1..100000] of boolean;
var d:vector;
    e:vectb;
    c,n,m,f,max1,max2:longint;
    rec,a,b:real;
    i,o:text;
procedure maxim;
begin
  max1:=1;
  max2:=2;
  for f:=2 to n do
    if d[f]>=d[max1] then
      begin
        max2:=max1;
        max1:=f
      end
    else
      if d[f]>d[max2] then
        max2:=f;
end;
procedure sortez;
var b:boolean;
    tf:longint;
    aux:real;
begin
  tf:=n;
  repeat
    b:=true;
    for f:=2 to tf do
      if d[f-1]<d[f] then
        begin
          aux:=d[f-1];
          d[f-1]:=d[f];
          d[f]:=aux;
          b:=false
        end;
    tf:=tf-1
  until b
end;
function verifica:boolean;
var sum:real;
    f:longint;
begin
  sum:=d[1];
  for f:=2 to n do
    sum:=sum+d[f];
  if (sum<rec) or (abs(sum-rec)<0.000001) then
    verifica:=true
  else
    verifica:=false
end;
begin
  c:=0;
  assign(i,'minim2.in');
  reset(i);
  assign(o,'minim2.out');
  rewrite(o);
  readln(i,n);
  for f:=1 to n do
    read(i,d[f]);
  read(i,a,b,rec);

    begin
      maxim;
      repeat
        if d[max1]>=d[max2] then
          if not(e[max1]) then
            begin
              d[max1]:=d[max1]*a;
              e[max1]:=true
            end
          else
            if e[max2] then
              d[max1]:=d[max1]*b
            else
              if d[max2]*a<d[max1]*b then
                begin
                  d[max2]:=d[max2]*a;
                  e[max2]:=true
                end
              else
                d[max1]:=d[max1]*b
        else
          begin
            if not(e[max2]) then
              begin
                d[max2]:=d[max2]*a;
                e[max2]:=true
              end
            else
              if e[max1] then
                d[max2]:=d[max2]*b
              else
                if d[max1]*a<d[max2]*b then
                  begin
                    d[max1]:=d[max1]*a;
                    e[max1]:=true
                  end
                else
                  d[max2]:=d[max2]*b;
            maxim
          end;
        c:=c+1
      until verifica;
      write(o,c)
    end;
  close(o)
end.