lvaruzza / cl-randist
watch download tarball
public
Forks0Right
Watchers5Right
Description: Random number generation for common lisp
Homepage: http://code.google.com/p/cl-randist/
Clone URL: git://github.com/lvaruzza/cl-randist.git
cl-randist / f.lisp
100644 39 lines (25 sloc) 0.977 kb
raw blame history 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

(in-package :randist)
 
(declaim (optimize (speed 3) (debug 0) (safety 1)))
 
;; /* The F distribution has the form
 
;;    p(x) dx = (nu1^(nu1/2) nu2^(nu2/2) Gamma((nu1 + nu2)/2) /
;;    Gamma(nu1/2) Gamma(nu2/2)) *
;;    x^(nu1/2 - 1) (nu2 + nu1 * x)^(-nu1/2 -nu2/2) dx
 
;;    The method used here is the one described in Knuth */
 
;; double
;; gsl_ran_fdist (const gsl_rng * r, const double nu1, const double nu2)
;; {
 
;;   double Y1 =  gsl_ran_gamma (r, nu1 / 2, 2.0);
;;   double Y2 =  gsl_ran_gamma (r, nu2 / 2, 2.0);
 
;;   double f = (Y1 * nu2) / (Y2 * nu1);
 
;;   return f;
;; }
 
(defun random-f (nu1 nu2)
   "Random value for:
 
p(x) dx = (nu1^(nu1/2) nu2^(nu2/2) Gamma((nu1 + nu2)/2) /
Gamma(nu1/2) Gamma(nu2/2)) *
x^(nu1/2 - 1) (nu2 + nu1 * x)^(-nu1/2 -nu2/2) dx"
   
   (declare (type double-float nu1 nu2))
 
   (let ((y1 (random-gamma (/ nu1 2d0) 2d0))
	 (y2 (random-gamma (/ nu2 2d0) 2d0)))
 
     (declare (type double-float y1 y2))
     (/ (* y1 nu2) (* y2 nu1))))