Cod sursa(job #329394)

Utilizator ionutz32Ilie Ionut ionutz32 Data 6 iulie 2009 08:40:20
Problema Dezastru Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 1 kb
{$N+}  
var v:array[1..25] of 1..25;  
u:array[1..25] of extended;  
n,k,i,fact,j,fact2:longint;  
s,p:extended;  
f,g:text;  
ok,l:boolean;
begin
assign(f,'dezastru.in');
assign(g,'dezastru.out');
reset(f);rewrite(g);
readln(f,n,k);
for i:=1 to n do
    read(f,u[i]);
fact:=1;
for i:=k+1 to n do
    fact:=fact*i;
fact2:=1;
for i:=2 to n-k do
    fact2:=fact2*i;
for i:=1 to k do
    v[i]:=i;
repeat
      if ok=true then
         l:=true;
      p:=1;
      for i:=1 to k do
          p:=p*u[v[i]];
      s:=s+p;
      if n=k then
         break;
      i:=k;
      while k-i>n-v[i]-1 do
            i:=i-1;
      v[i]:=v[i]+1;
      for j:=i+1 to k do
          v[j]:=v[i]+j-i;
      ok:=true;
      if v[k]<>n then
         ok:=false
      else
          for i:=k downto 2 do
              if v[i]<>v[i-1]+1 then
                 begin
                 ok:=false;
                 break;
                 end;
until l=true;
write(g,fact2*s/fact:5:6);
close(f);close(g);
end.