double rbeta(double aa, double bb)
{
/* From R sources
*
* Reference:
* R. C. H. Cheng (1978).
* Generating beta variates with nonintegral shape parameters.
* Communications of the ACM 21, 317-322.
* (Algorithms BB and BC)
*/
double a, b, alpha;
double r, s, t, u1, u2, v, w, y, z;
int qsame;
/* FIXME: Keep Globals (properly) for threading */
/* Uses these GLOBALS to save time when many rv's are generated : */
static double beta, gamma, delta, k1, k2;
static double olda = -1.0;
static double oldb = -1.0;
/*if (aa <= 0. || bb <= 0. || (!R_FINITE(aa) && !R_FINITE(bb)))
ML_ERR_return_NAN;
if (!R_FINITE(aa))
return 1.0;
if (!R_FINITE(bb))
return 0.0;*/
myassert(aa>0. && bb>0.);
/* Test if we need new "initializing" */
qsame = (olda == aa) && (oldb == bb);
if (!qsame) { olda = aa; oldb = bb; }
a = fmin(aa, bb);
b = fmax(aa, bb); /* a <= b */
alpha = a + b;
#define v_w_from__u1_bet(AA) \
v = beta * log(u1 / (1.0 - u1)); \
if (v <= expmax) \
w = AA * exp(v); \
else \
w = DBL_MAX
if (a <= 1.0) { /* --- Algorithm BC --- */
/* changed notation, now also a <= b (was reversed) */
if (!qsame) { /* initialize */
beta = 1.0 / a;
delta = 1.0 + b - a;
k1 = delta * (0.0138889 + 0.0416667 * a) / (b * beta - 0.777778);
k2 = 0.25 + (0.5 + 0.25 / delta) * a;
}
/* FIXME: "do { } while()", but not trivially because of "continue"s:*/
for(;;) {
u1 = rndv();
u2 = rndv();
if (u1 < 0.5) {
y = u1 * u2;
z = u1 * y;
if (0.25 * u2 + z - y >= k1)
continue;
} else {
z = u1 * u1 * u2;
if (z <= 0.25) {
v_w_from__u1_bet(b);
break;
}
if (z >= k2)
continue;
}
v_w_from__u1_bet(b);
if (alpha * (log(alpha / (a + w)) + v) - 1.3862944 >= log(z))
break;
}
return (aa == a) ? a / (a + w) : w / (a + w);
}
else { /* Algorithm BB */
if (!qsame) { /* initialize */
beta = sqrt((alpha - 2.0) / (2.0 * a * b - alpha));
gamma = a + 1.0 / beta;
}
do {
u1 = rndv();
u2 = rndv();
v_w_from__u1_bet(a);
z = u1 * u1 * u2;
r = gamma * v - 1.3862944;
s = a + r - w;
if (s + 2.609438 >= 5.0 * z)
break;
t = log(z);
if (s > t)
break;
}
while (r + alpha * log(alpha / (b + w)) < t);
return (aa != a) ? b / (b + w) : w / (b + w);
}
}
double rbeta(double aa, double bb, JRNG *rng)
{
if (aa < 0. || bb < 0.)
ML_ERR_return_NAN;
if (!R_FINITE(aa) && !R_FINITE(bb)) // a = b = Inf : all mass at 1/2
return 0.5;
if (aa == 0. && bb == 0.) // point mass 1/2 at each of {0,1} :
return (unif_rand(rng) < 0.5) ? 0. : 1.;
// now, at least one of a, b is finite and positive
if (!R_FINITE(aa) || bb == 0.)
return 1.0;
if (!R_FINITE(bb) || aa == 0.)
return 0.0;
double a, b, alpha;
double r, s, t, u1, u2, v, w, y, z;
int qsame;
/* FIXME: Keep Globals (properly) for threading */
/* Uses these GLOBALS to save time when many rv's are generated : */
static double beta, gamma, delta, k1, k2;
static double olda = -1.0;
static double oldb = -1.0;
/* Test if we need new "initializing" */
qsame = (olda == aa) && (oldb == bb);
if (!qsame) { olda = aa; oldb = bb; }
a = fmin2(aa, bb);
b = fmax2(aa, bb); /* a <= b */
alpha = a + b;
#define v_w_from__u1_bet(AA) \
v = beta * log(u1 / (1.0 - u1)); \
if (v <= expmax) { \
w = AA * exp(v); \
if(!R_FINITE(w)) w = DBL_MAX; \
} else \
w = DBL_MAX
if (a <= 1.0) { /* --- Algorithm BC --- */
/* changed notation, now also a <= b (was reversed) */
if (!qsame) { /* initialize */
beta = 1.0 / a;
delta = 1.0 + b - a;
k1 = delta * (0.0138889 + 0.0416667 * a) / (b * beta - 0.777778);
k2 = 0.25 + (0.5 + 0.25 / delta) * a;
}
/* FIXME: "do { } while()", but not trivially because of "continue"s:*/
for(;;) {
u1 = unif_rand(rng);
u2 = unif_rand(rng);
if (u1 < 0.5) {
y = u1 * u2;
z = u1 * y;
if (0.25 * u2 + z - y >= k1)
continue;
} else {
z = u1 * u1 * u2;
if (z <= 0.25) {
v_w_from__u1_bet(b);
break;
}
if (z >= k2)
continue;
}
v_w_from__u1_bet(b);
if (alpha * (log(alpha / (a + w)) + v) - 1.3862944 >= log(z))
break;
}
return (aa == a) ? a / (a + w) : w / (a + w);
}
else { /* Algorithm BB */
if (!qsame) { /* initialize */
beta = sqrt((alpha - 2.0) / (2.0 * a * b - alpha));
gamma = a + 1.0 / beta;
}
do {
u1 = unif_rand(rng);
u2 = unif_rand(rng);
v_w_from__u1_bet(a);
z = u1 * u1 * u2;
r = gamma * v - 1.3862944;
s = a + r - w;
if (s + 2.609438 >= 5.0 * z)
break;
t = log(z);
if (s > t)
break;
}
while (r + alpha * log(alpha / (b + w)) < t);
return (aa != a) ? b / (b + w) : w / (b + w);
}
}
double rbeta_mt(BOOM::RNG & rng, double aa, double bb){
// The R version IS NOT THREAD SAFE because of the static
// variables I took out the static variables, so this function now
// reinitializes every time. If this takes too long then consider
// using two calls to a boost::gamma_distribution to do the draws
double a, b, alpha;
double r, s, t, u1, u2, v, w, y, z;
// int qsame;
/* FIXME: Keep Globals (properly) for threading */
/* Uses these GLOBALS to save time when many rv's are generated : */
double beta, gamma, delta, k1, k2;
// static double beta, gamma, delta, k1, k2;
// static double olda = -1.0;
// static double oldb = -1.0;
if (aa <= 0. || bb <= 0. || (!R_FINITE(aa) && !R_FINITE(bb)))
ML_ERR_return_NAN;
if (!R_FINITE(aa))
return 1.0;
if (!R_FINITE(bb))
return 0.0;
/* Test if we need new "initializing" */
// qsame = (olda == aa) && (oldb == bb);
// if (!qsame) { olda = aa; oldb = bb; }
a = std::min(aa, bb);
b = std::max(aa, bb); /* a <= b */
alpha = a + b;
#define v_w_from__u1_bet(AA) \
v = beta * log(u1 / (1.0 - u1)); \
if (v <= expmax) \
w = AA * exp(v); \
else \
w = numeric_limits<double>::max()
if (a <= 1.0) { /* --- Algorithm BC --- */
/* changed notation, now also a <= b (was reversed) */
// if (!qsame) { /* initialize */
beta = 1.0 / a;
delta = 1.0 + b - a;
k1 = delta * (0.0138889 + 0.0416667 * a) / (b * beta - 0.777778);
k2 = 0.25 + (0.5 + 0.25 / delta) * a;
// }
/* FIXME: "do { } while()", but not trivially because of "continue"s:*/
for(;;) {
// u1 = unif_rand();
// u2 = unif_rand();
u1 = rng();
u2 = rng();
if (u1 < 0.5) {
y = u1 * u2;
z = u1 * y;
if (0.25 * u2 + z - y >= k1)
continue;
} else {
z = u1 * u1 * u2;
if (z <= 0.25) {
v_w_from__u1_bet(b);
break;
}
if (z >= k2)
continue;
}
v_w_from__u1_bet(b);
if (alpha * (log(alpha / (a + w)) + v) - 1.3862944 >= log(z))
break;
}
return (aa == a) ? a / (a + w) : w / (a + w);
}
else { /* Algorithm BB */
// if (!qsame) { /* initialize */
beta = sqrt((alpha - 2.0) / (2.0 * a * b - alpha));
gamma = a + 1.0 / beta;
// }
do {
u1 = rng();
u2 = rng();
// u1 = unif_rand();
// u2 = unif_rand();
v_w_from__u1_bet(a);
z = u1 * u1 * u2;
r = gamma * v - 1.3862944;
s = a + r - w;
if (s + 2.609438 >= 5.0 * z)
break;
t = log(z);
if (s > t)
break;
}
while (r + alpha * log(alpha / (b + w)) < t);
return (aa != a) ? b / (b + w) : w / (b + w);
}
}
