Cod sursa(job #241381)

Utilizator MihaiBunBunget Mihai MihaiBun Data 9 ianuarie 2009 22:38:21
Problema Dezastru Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.14 kb
program vai;
var f:text;
    n,i,j,k:0..30;
    st:array[0..30] of 0..30;
    as,ev:boolean;
    p:array[1..30] of real;
    s,prod:double;
begin
  assign(f,'dezastru.in');
  reset(f);
  readln(f,n,k);
  for i:=1 to n do read(f,p[i]);
  close(f);
  assign(f,'dezastru.out');
  rewrite(f);
  j:=1;
  st[0]:=0;
  st[1]:=0;
  s:=0;
  while j>0 do
    begin
      repeat
        if st[j]<n then begin
                         st[j]:=st[j]+1;
                         as:=true
                        end
                   else as:=false;
        if st[j]>st[j-1] then ev:=true
                         else ev:=false
      until (not as) or (as and ev);
      if as then if j=k then begin

                              prod:=1;
                              for i:=1 to j do prod:=prod*p[st[i]];
                              s:=s+prod
                             end
                        else begin
                              j:=j+1;
                              st[j]:=st[j-1]
                             end
            else j:=j-1;

  end;
  for i:=(k+1) to n do s:=s/i;
  write(f,s:8:6);
  close(f);
  end.