15184Sek110237 /*
25184Sek110237 * CDDL HEADER START
35184Sek110237 *
45184Sek110237 * The contents of this file are subject to the terms of the
55184Sek110237 * Common Development and Distribution License (the "License").
65184Sek110237 * You may not use this file except in compliance with the License.
75184Sek110237 *
85184Sek110237 * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
95184Sek110237 * or http://www.opensolaris.org/os/licensing.
105184Sek110237 * See the License for the specific language governing permissions
115184Sek110237 * and limitations under the License.
125184Sek110237 *
135184Sek110237 * When distributing Covered Code, include this CDDL HEADER in each
145184Sek110237 * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
155184Sek110237 * If applicable, add the following below this CDDL HEADER, with the
165184Sek110237 * fields enclosed by brackets "[]" replaced with your own identifying
175184Sek110237 * information: Portions Copyright [yyyy] [name of copyright owner]
185184Sek110237 *
195184Sek110237 * CDDL HEADER END
205184Sek110237 */
215184Sek110237 /*
22*6212Saw148015 * Copyright 2008 Sun Microsystems, Inc. All rights reserved.
235184Sek110237 * Use is subject to license terms.
245184Sek110237 */
255184Sek110237
265184Sek110237 #pragma ident "%Z%%M% %I% %E% SMI"
275184Sek110237
285184Sek110237 #include <stdlib.h>
295184Sek110237 #include <math.h>
305184Sek110237
315184Sek110237 /*
325184Sek110237 * This is valid for 0 < a <= 1
335184Sek110237 *
345184Sek110237 * From Knuth Volume 2, 3rd edition, pages 586 - 587.
355184Sek110237 */
365184Sek110237 static double
gamma_dist_knuth_algG(double a,double (* src)(unsigned short *),unsigned short * xi)37*6212Saw148015 gamma_dist_knuth_algG(double a, double (*src)(unsigned short *),
38*6212Saw148015 unsigned short *xi)
395184Sek110237 {
405184Sek110237 double p, U, V, X, q;
415184Sek110237
425184Sek110237 p = M_E/(a + M_E);
435184Sek110237 G2:
44*6212Saw148015 /* get a random number U */
45*6212Saw148015 U = (*src)(xi);
46*6212Saw148015
475184Sek110237 do {
48*6212Saw148015 /* get a random number V */
49*6212Saw148015 V = (*src)(xi);
50*6212Saw148015
515184Sek110237 } while (V == 0);
525184Sek110237
535184Sek110237 if (U < p) {
545184Sek110237 X = pow(V, 1/a);
555184Sek110237 /* q = e^(-X) */
565184Sek110237 q = exp(-X);
575184Sek110237 } else {
585184Sek110237 X = 1 - log(V);
595184Sek110237 q = pow(X, a-1);
605184Sek110237 }
615184Sek110237
625184Sek110237 /*
635184Sek110237 * X now has density g, and q = f(X)/cg(X)
645184Sek110237 */
65*6212Saw148015
66*6212Saw148015 /* get a random number U */
67*6212Saw148015 U = (*src)(xi);
68*6212Saw148015
695184Sek110237 if (U >= q)
705184Sek110237 goto G2;
715184Sek110237 return (X);
725184Sek110237 }
735184Sek110237
745184Sek110237 /*
755184Sek110237 * This is valid for a > 1
765184Sek110237 *
775184Sek110237 * From Knuth Volume 2, 3rd edition, page 134.
785184Sek110237 */
795184Sek110237 static double
gamma_dist_knuth_algA(double a,double (* src)(unsigned short *),unsigned short * xi)80*6212Saw148015 gamma_dist_knuth_algA(double a, double (*src)(unsigned short *),
81*6212Saw148015 unsigned short *xi)
825184Sek110237 {
835184Sek110237 double U, Y, X, V;
845184Sek110237
855184Sek110237 A1:
86*6212Saw148015 /* get a random number U */
87*6212Saw148015 U = (*src)(xi);
88*6212Saw148015
895184Sek110237 Y = tan(M_PI*U);
905184Sek110237 X = (sqrt((2*a) - 1) * Y) + a - 1;
915184Sek110237
925184Sek110237 if (X <= 0)
935184Sek110237 goto A1;
945184Sek110237
95*6212Saw148015 /* get a random number V */
96*6212Saw148015 V = (*src)(xi);
97*6212Saw148015
985184Sek110237 if (V > ((1 + (Y*Y)) * exp((a-1) * log(X/(a-1)) - sqrt(2*a -1) * Y)))
995184Sek110237 goto A1;
1005184Sek110237
1015184Sek110237 return (X);
1025184Sek110237 }
1035184Sek110237
104*6212Saw148015 /*
105*6212Saw148015 * fetch a uniformly distributed random number using the drand48 generator
106*6212Saw148015 */
107*6212Saw148015 /* ARGSUSED */
108*6212Saw148015 static double
default_src(unsigned short * xi)109*6212Saw148015 default_src(unsigned short *xi)
110*6212Saw148015 {
111*6212Saw148015 return (drand48());
112*6212Saw148015 }
113*6212Saw148015
114*6212Saw148015 /*
115*6212Saw148015 * Sample the gamma distributed random variable with gamma 'a' and
116*6212Saw148015 * result mulitplier 'b', which is usually mean/gamma. Uses the default
117*6212Saw148015 * drand48 random number generator as input
118*6212Saw148015 */
1195184Sek110237 double
gamma_dist_knuth(double a,double b)1205184Sek110237 gamma_dist_knuth(double a, double b)
1215184Sek110237 {
1225184Sek110237 if (a <= 1.0)
123*6212Saw148015 return (b * gamma_dist_knuth_algG(a, default_src, NULL));
1245184Sek110237 else
125*6212Saw148015 return (b * gamma_dist_knuth_algA(a, default_src, NULL));
1265184Sek110237 }
127*6212Saw148015
128*6212Saw148015 /*
129*6212Saw148015 * Sample the gamma distributed random variable with gamma 'a' and
130*6212Saw148015 * multiplier 'b', which is mean / gamma adjusted for the specified
131*6212Saw148015 * minimum value. The suppled random number source function is
132*6212Saw148015 * used to optain the uniformly distributed random numbers.
133*6212Saw148015 */
134*6212Saw148015 double
gamma_dist_knuth_src(double a,double b,double (* src)(unsigned short *),unsigned short * xi)135*6212Saw148015 gamma_dist_knuth_src(double a, double b,
136*6212Saw148015 double (*src)(unsigned short *), unsigned short *xi)
137*6212Saw148015 {
138*6212Saw148015 if (a <= 1.0)
139*6212Saw148015 return (b * gamma_dist_knuth_algG(a, src, xi));
140*6212Saw148015 else
141*6212Saw148015 return (b * gamma_dist_knuth_algA(a, src, xi));
142*6212Saw148015 }
143