Cod sursa(job #265094)

Utilizator DalaDosDalalau Alexandru DalaDos Data 23 februarie 2009 11:30:17
Problema Dezastru Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.32 kb
var f,g:text;
    n,k,j:byte;
    p,s:real;
    sol:array[1..25]of byte;
    a:array[1..25]of real;

procedure init(vf:byte);
begin
        sol[vf]:=0;
end;

function succ(vf:byte):boolean;
begin
   if sol[vf]<n then
   begin
      inc(sol[vf]);
      succ:=true;
   end else
       succ:=false;
end;

function valid(vf:byte):boolean;
var i:byte;
begin
     valid:=true;
     for i:=1 to vf-1 do
         if sol[i]=sol[vf] then valid:=false;
end;

function ok(vf:byte):boolean;
begin
   if vf=k+1 then ok:=true
            else ok:=false;
end;

procedure tipar;
var i:byte;
begin
    p:=1;
    for i:=1 to k do
        p:=a[sol[i]]*p;
end;

procedure perm(vf:byte);
begin
   if ok(vf) then
                 begin
                      tipar;
                      s:=s+p;
                 end
      else
      begin
         init(vf);
         while succ(vf) do
            if valid(vf) then perm(vf+1);

      end;
end;
begin
     assign(f,'dezastru.in');
     assign(g,'dezastru.out');
     reset(f);
     rewrite(g);
     read(f,n,k);
     for j:=1 to n do
         read(f,a[j]);
     perm(1);
     for j:=2 to n do
     {    s:=trunc(1000000*s/j)/1000000;}
     s:=s/j;
     for j:=2 to n-k do
         s:=s*j;
     write(g,s:8:6);
     close(f);
     close(g);
end.