Cod sursa(job #241357)

Utilizator MihaiBunBunget Mihai MihaiBun Data 9 ianuarie 2009 21:44:37
Problema Dezastru Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.43 kb
program vai;
var f:text;
    n,i,j,k:longint;
    v,st:array[1..30] of 0..30;
    as,ev:boolean;
    p:array[1..30] of real;
    s,prod:real;
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[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 as then if v[st[j]]=1 then ev:=false
                                   else begin
                                         ev:=true;
                                         v[st[j]]:=1
                                        end;
      until (not as) or (as and ev);
      if as then if j=k then begin
                              v[st[j]]:=0;
                              prod:=1;
                              for i:=1 to j do prod:=prod*p[st[i]];
                              for i:=2 to n do prod:=prod/i;
                              s:=s+prod
                             end
                        else begin
                              j:=j+1;
                              st[j]:=0
                             end
            else
             begin
              j:=j-1;
              v[st[j]]:=0
             end;
  end;

  write(f,s:8:6);
  close(f);
  end.