Cod sursa(job #465915)

Utilizator MihaicorneliuMihai Pojar Mihaicorneliu Data 25 iunie 2010 13:58:43
Problema Minim2 Scor 0
Compilator fpc Status done
Runda Stelele Informaticii 2010, gimnaziu si clasa a IX-a, Ziua 1 Marime 2.64 kb
program minim2;
type vector=array[1..100000] of real;
     vectb=array[1..100000] of boolean;
var d:vector;
    e:vectb;
    c,n,f,max1,max2:longint;
    rec,a,b,dif,sum: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;
begin
  c:=0;
  assign(i,'minim2.in');
  reset(i);
  assign(o,'minim2.out');
  rewrite(o);
  readln(i,n);
  for f:=1 to n do
    begin
      e[f]:=false;
      read(i,d[f])
    end;
  read(i,a,b,rec);
  for f:=2 to n do
    sum:=sum+d[f];
  dif:=sum-rec-0.000001;
    begin
      maxim;
      repeat
        if d[max1]>=d[max2] then
          if not(e[max1]) then
            begin
              dif:=dif-(d[max1]-d[max1]*a);
              d[max1]:=d[max1]*a;
              e[max1]:=true
            end
          else
            if e[max2] then
              begin
              dif:=dif-(d[max1]-d[max1]*b);
              d[max1]:=d[max1]*b;
              end
            else
              if d[max2]*a<d[max1]*b then
                begin
                  dif:=dif-(d[max2]-d[max2]*a);
                  d[max2]:=d[max2]*a;
                  e[max2]:=true
                end
              else
                begin
                dif:=dif-(d[max1]-d[max1]*b);
                d[max1]:=d[max1]*b
                end
        else
          begin
            if not(e[max2]) then
              begin
                dif:=dif-(d[max2]-d[max2]*a);
                d[max2]:=d[max2]*a;
                e[max2]:=true
              end
            else
              if e[max1] then
              begin
                dif:=dif-(d[max2]-d[max2]*b);
                d[max2]:=d[max2]*b
              end
              else
                if d[max1]*a<d[max2]*b then
                  begin
                    dif:=dif-(d[max1]-d[max1]*a);
                    d[max1]:=d[max1]*a;
                    e[max1]:=true
                  end
                else
                  begin
                  dif:=dif-(d[max2]-d[max2]*b);
                  d[max2]:=d[max2]*b
                  end;
            maxim
          end;
        c:=c+1
      until dif<=0;
      write(o,c)
    end;
  close(o)
end.