Cod sursa(job #164890)

Utilizator eugen.nodeaEugen Nodea eugen.nodea Data 24 martie 2008 22:01:22
Problema Dezastru Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.66 kb
{$N+}
const nmax=26;
var f:text;
    v:array[1..nmax] of real;
    p:longint;
    n,i,j,k,kk:byte;
    s,sp:extended;
    st:array[0..nmax] of byte;
    ev,as:boolean;
    ap:array[1..nmax] of 0..1;
begin
     assign(f,'dezastru.in');reset(f);
     readln(f,n,k);
     for i:=1 to n do
         read(f,v[i]);
     close(f);
     p:=0;
     kk:=1;
     assign(f,'dezastru.out');rewrite(f);
     while kk>0 do
     begin
          repeat
                as:=St[kk]<n-(kk-k);
                if as then begin
                                st[kk]:=st[kk]+1;
                                ev:=ap[st[kk]]=0;
                           end;
          until (as and ev) Or Not as;
          if as then
                        if kk=k then begin
                                       ap[st[kk]]:=1;
                                       sp:=1;
                                       For j:=1 To k do
                                           sp:=sp*v[st[j]];
                                       s:=s+sp;
                                       p:=p+1;
                                       ap[st[kk]]:=0;
                                  end
                             else begin
                                       ap[st[kk]]:=1;
                                       kk:=kk+1;
                                       st[kk]:=st[kk-1];
                                  end
                else begin
                          ap[st[kk]]:=0;
                          st[kk]:=0;
                          kk:=kk-1;
                          ap[st[kk]]:=0;
                     end;
     end;
     writeln(f,(s/p):0:6);
     close(f);
End.