Cod sursa(job #296314)

Utilizator mlazariLazari Mihai mlazari Data 4 aprilie 2009 16:42:49
Problema Dezastru Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.23 kb
Program Dezastru;
var n,k : byte;
    P : array[1..25] of real;
    C : array[1..25] of byte;
    stop : boolean;
    rez : real;

procedure Citeste;
var Intrare : text;
    i : byte;
begin
  assign(Intrare,'dezastru.in');
  reset(Intrare);
  readln(Intrare,n,k);
  for i:=1 to n do read(Intrare,P[i]);
  close(Intrare);
end;

function fact(n : byte) : real;
var f : real;
    i : byte;
begin
  f:=1;
  for i:=2 to n do f:=f*i;
  fact:=f;
end;

function prod : real;
var pr : real;
    i : byte;
begin
  pr:=1;
  for i:=1 to k do pr:=pr*p[C[i]];
  prod:=pr;
end;

procedure Next;
var i,j : byte;
begin
  i:=k;
  while (C[i]=n-k+i) and (i>1) do i:=i-1;
  if (i=1) and (C[1]=n-k+1) then stop:=true
  else begin
    C[i]:=C[i]+1;
    for j:=i+1 to k do C[j]:=C[j-1]+1;
  end;
end;

procedure Calculeaza;
var i : byte;
    fn,fk : real;
begin
  fn:=fact(n);
  fk:=fact(k);
  for i:=1 to k do C[i]:=i;
  stop:=false;
  rez:=0;
  repeat
    rez:=rez+prod;
    Next;
  until stop;
  rez:=rez*fk/fn;
end;

procedure Scrie;
var Iesire : text;
begin
  assign(Iesire,'dezastru.out');
  rewrite(Iesire);
  write(Iesire,rez:0:6);
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
end.