value gamma_CAML_randgamma( value sh, value sc )
{
CAMLparam2( sh,sc );
CAMLlocal1( r );
r = caml_copy_double( rand_gamma( Double_val(sh), Double_val(sc) ) );
CAMLreturn( r );
}
int ac_demag(GLASS_SK *sys, double H){
// AC demagnetization starting from H to 0.
// Return the number of half cycles in the whole procedure.
int i, j, quench_time, cycle_time = 0 ;
double h1, h2;
/* Repeat cycles until no more quech is needed */
h2 = H;
do{
h1 = h2;
h2 = - rand_gamma() * h1;
quench_time = half_cycle(sys, h1, h2);
cycle_time += 1;
}while(quench_time > 0);
/* Bring the system back to H = 0 */
sys->H = 0;
update_sys(sys);
identify_unstable(sys);
/* Calculate the magnetization with no xi[i] factors */
sys->magnetization = 0;
for(i = 0; i < sys->N; i++)
sys->magnetization += sys->sigma[i];
return cycle_time;
}
/** [rand_gamma a b]
* Implementation based on "A Simple Method for Generating Gamma Variables"
* by George Marsaglia and Wai Wan Tsang.
* ACM Transactions on Mathematical Software
* Vol 26, No 3, September 2000, pages 363-372.
*/
double rand_gamma( const double shape, const double scale )
{
double g,w,x,v,c,d,xsq,u;
assert( shape > 0.0 );
assert( scale > 0.0 );
srand( time(NULL) );
if( shape >= 1.0 ){
d = shape - 1.0 / 3.0;
c = 1.0 / (sqrt( 9.0 * d));
do {
x = rand_normal(0, 1);
v = 1.0 + c *x;
while( v <= 0.0 ){
x = rand_normal(0, 1);
v = 1.0 + c * x;
}
v = v*v*v;
u = rand();
xsq = x*x;
} while((u < (1.0 - 0.331 * xsq * xsq))
|| (log(u) < (0.5*xsq + d*(1.0-v+log(v)))));
} else {
g = rand_gamma( shape + 1.0, 1.0 );
w = rand();
return (scale*g*pow(w,1.0/shape));
}
return (scale * d * v);
}
double rand_beta
( double a,
double b
)
{
double x, y, r;
do
{ x = rand_gamma(a);
y = rand_gamma(b);
r = 1.0 + x/(x+y);
r = r - 1.0;
} while (r<=0.0 || r>=1.0);
return r;
}
double rand_gamma
( double a
)
{
double b, c, X, Y, Z, U, V, W;
if (a<0.00001)
{ X = a;
}
else if (a<=1)
{
U = rand_uniopen();
X = rand_gamma(1+a) * pow(U,1/a);
}
else if (a<1.00001)
{ X = rand_exp();
}
else
{
b = a-1;
c = 3*a - 0.75;
for (;;)
{
U = rand_uniopen();
V = rand_uniopen();
W = U*(1-U);
Y = sqrt(c/W) * (U-0.5);
X = b+Y;
if (X>=0)
{
Z = 64*W*W*W*V*V;
if (Z <= 1 - 2*Y*Y/X || log(Z) <= 2 * (b*log(X/b) - Y)) break;
}
}
}
return X<1e-30 && X<a ? (a<1e-30 ? a : 1e-30) : X;
}
void FC_hrandom_variance_vec::update(void)
{
b_invgamma = masterp->level1_likep[equationnr]->trmult*b_invgamma_orig;
register unsigned i;
double * workbeta = beta.getV();
double * workbetafcn = FCnonpp->beta.getV();
double hyperLambda2 = hyperLambda*hyperLambda;
double sumtau2 = 0;
double * linpredREp;
if (likepRE->linpred_current==1)
linpredREp = likepRE->linearpred1.getV();
else
linpredREp = likepRE->linearpred2.getV();
double * ww = likepRE->workingweight.getV();
for (i=0; i<beta.rows(); i++,workbeta++,workbetafcn++,ww++,linpredREp++)
{
*workbeta = rand_inv_gaussian(fabs(hyperLambda)/
fabs((*workbetafcn - (*linpredREp))),hyperLambda2);
*ww = 1/(*workbeta);
sumtau2 += (*workbeta);
}
hyperLambda = sqrt(rand_gamma(a_invgamma+beta.rows(),b_invgamma+0.5*sumtau2));
FCnonpp->tau2 = 1;
designp->compute_penalty2(beta);
likepRE->sigma2 = 1;
acceptance++;
FC::update();
}
void mexFunction(const int nlhs_, mxArray *plhs_[],
const int nrhs_, const mxArray *prhs_[])
{
if (nrhs_ != 2 )
mexErrMsgTxt( "Wrong number of input arguments." );
if (nlhs_ > 1 )
mexErrMsgTxt( "Too many output arguments." );
{
double a, b;
a=mxGetScalar(prhs_[0]);
b=mxGetScalar(prhs_[1]);
plhs_[0]=mxCreateDoubleMatrix(1,1,mxREAL);
*mxGetPr(plhs_[0]) =
a*b/2/rand_gamma(b/2);
}
return;
}
void mexFunction(const int nlhs, mxArray *plhs[],
const int nrhs, const mxArray *prhs[])
{
if (nlhs > 1 )
mexErrMsgTxt( "Too many output arguments." );
if ((nrhs < 2) | (nrhs == 3) | (nrhs > 4))
mexErrMsgTxt( "Wrong number of input arguments." );
{
double a, b, *aa, *bb, *r;
const int *dims1, *dims2;
int i, m, n, mn;
dims1 = mxGetDimensions(prhs[0]);
dims2 = mxGetDimensions(prhs[1]);
if ((dims1[0] > 1 || dims1[1] > 1) &&
(dims2[0] > 1 || dims2[1] > 1) &&
(dims1[0]!=dims2[0] || dims1[1]!=dims2[1]))
mexErrMsgTxt( "Size information is inconsistent." );
if (nrhs < 3) {
if (dims1[0] > 1 || dims1[1] > 1) {
m = dims1[0];
n = dims1[1];
}
else {
m = dims2[0];
n = dims2[1];
}
}
else {
m=(int)mxGetScalar(prhs[2]);
n=(int)mxGetScalar(prhs[3]);
if (((dims1[0] > 1 || dims1[1] > 1) && dims1[0]!=m && dims1[1]!=n) ||
((dims2[0] > 1 || dims2[1] > 1) && dims2[0]!=m && dims2[1]!=n))
mexErrMsgTxt( "Size information is inconsistent." );
}
plhs[0]=mxCreateDoubleMatrix(m,n,mxREAL);
r = mxGetPr(plhs[0]);
mn=m*n;
if (dims1[0] > 1 || dims1[1] > 1) {
if (dims2[0] > 1 || dims2[1] > 1) {
aa=mxGetPr(prhs[0]);
bb=mxGetPr(prhs[1]);
for (i = 0; i < mn; i++)
r[i] = aa[i]*bb[i]/2/rand_gamma(bb[i]/2);
}
else {
aa=mxGetPr(prhs[0]);
b=mxGetScalar(prhs[1]);
for (i = 0; i < mn; i++)
r[i] = aa[i]*b/2/rand_gamma(b/2);
}
}
else {
if (dims2[0] > 1 || dims2[1] > 1) {
a=mxGetScalar(prhs[0]);
bb=mxGetPr(prhs[1]);
for (i = 0; i < mn; i++)
r[i] = a*bb[i]/2/rand_gamma(bb[i]/2);
}
else {
a=mxGetScalar(prhs[0]);
b=mxGetScalar(prhs[1]);
for (i = 0; i < mn; i++)
r[i] = a*b/2/rand_gamma(b/2);
}
}
}
return;
}
double rgamma_inv(void) {
double x = rand_gamma(rng,100,1.0);
return gsl_cdf_gamma_P(x,100,1.0);
}
