unsigned int
gsl_ran_logarithmic (const gsl_rng * r, const double p)
{
double c = log (1-p) ;
double v = gsl_rng_uniform_pos (r);
if (v >= p)
{
return 1 ;
}
else
{
double u = gsl_rng_uniform_pos (r);
double q = 1 - exp (c * u);
if (v <= q*q)
{
double x = 1 + log(v)/log(q) ;
return x ;
}
else if (v <= q)
{
return 2;
}
else
{
return 1 ;
}
}
}
void SPF::initialize_parameters() {
int user, neighbor, n, item, i, k;
if (!settings->factor_only) {
for (user = 0; user < data->user_count(); user++) {
// user influence
for (n = 0; n < data->neighbor_count(user); n++) {
neighbor = data->get_neighbor(user, n);
tau(neighbor, user) = 1.0;
logtau(neighbor, user) = log(1.0 + 1e-5);
double all = settings->b_tau;
for (i = 0; i < data->item_count(neighbor); i++) {
item = data->get_item(neighbor, i);
all += data->ratings(neighbor, item);
} //TODO: this doeesn't need to be done as much... only one time per user (U), not UxU times
b_tau(neighbor, user) = all;
}
}
}
if (!settings->social_only) {
// user preferences
for (user = 0; user < data->user_count(); user++) {
for (k = 0; k < settings->k; k++) {
theta(k, user) = (settings->a_theta +
gsl_rng_uniform_pos(rand_gen))
/ (settings->b_theta);
logtheta(k, user) = log(theta(k, user));
}
theta.col(user) /= accu(theta.col(user));
}
// item attributes
for (item = 0; item < data->item_count(); item++) {
for (k = 0; k < settings->k; k++) {
beta(k, item) = (settings->a_beta +
gsl_rng_uniform_pos(rand_gen))
/ (settings->b_beta);
logbeta(k, item) = log(beta(k, item));
}
beta.col(item) /= accu(beta.col(item));
}
}
if (settings->item_bias) {
for (item = 0; item < data->item_count(); item++) {
delta(item) = data->popularity(item);
}
}
}
//gaussian distribution
double PoissonSource::randGauss( double min, double max, double sigma, double centre)
{
/*double random = (min + (max-min) * (double)rand()/RAND_MAX); //create random domain between [min,max]
double tmp = (random-centre)/sigma;
double gauss = exp(-tmp*tmp/2); //gaussian formula
*/
//Use Chi Square distribution with 2 degrees of freedom
double r1 = (double)gsl_rng_uniform_pos (rng_r);
double r2 = (double)gsl_rng_uniform_pos (rng_r);
//Note Log =ln
double gauss = sqrt(-2.0f*log(r1))*cos(2*M_PI*r2);
return gauss*sigma;
}
double
gsl_ran_rayleigh (const gsl_rng * r, const double sigma)
{
double u = gsl_rng_uniform_pos (r);
return sigma * sqrt(-2.0 * log (u));
}
static double
gamma_frac (const gsl_rng * r, const double a)
{
/* This is exercise 16 from Knuth; see page 135, and the solution is
on page 551. */
double p, q, x, u, v;
p = M_E / (a + M_E);
do
{
u = gsl_rng_uniform (r);
v = gsl_rng_uniform_pos (r);
if (u < p)
{
x = exp ((1 / a) * log (v));
q = exp (-x);
}
else
{
x = 1 - log (v);
q = exp ((a - 1) * log (x));
}
}
while (gsl_rng_uniform (r) >= q);
return x;
}
double
gsl_ran_gamma_int (const gsl_rng * r, const unsigned int a)
{
if (a < 12)
{
unsigned int i;
double prod = 1;
for (i = 0; i < a; i++)
{
prod *= gsl_rng_uniform_pos (r);
}
/* Note: for 12 iterations we are safe against underflow, since
the smallest positive random number is O(2^-32). This means
the smallest possible product is 2^(-12*32) = 10^-116 which
is within the range of double precision. */
return -log (prod);
}
else
{
return gamma_large (r, (double) a);
}
}
void gsl_vector_step_random(const gsl_rng* r, gsl_vector* v,
const double step_size)
{
const size_t n = v->size;
gsl_vector* vp = gsl_vector_alloc(n);
// Set normal distributed random numbers as elements of v_new and
// compute the euclidean norm of this vector.
double length = 0.;
for (size_t i = 0; i < n; ++i)
{
double* vp_i = gsl_vector_ptr(vp, i);
*vp_i = gsl_ran_ugaussian(r);
length += pow(*vp_i, 2);
}
length = sqrt(length);
// Scale vp so that the elements of vp are uniformly distributed
// within an n-sphere of radius step_size.
const double scale = pow(pow(step_size, boost::numeric_cast<int>(n))
* gsl_rng_uniform_pos(r), 1.0/n) / length;
gsl_vector_scale(vp, scale);
gsl_vector_add(v, vp);
}
double
gsl_ran_rayleigh_tail (const gsl_rng * r, const double a, const double sigma)
{
double u = gsl_rng_uniform_pos (r);
return sqrt(a * a - 2.0 * sigma * sigma * log (u));
}
double
gsl_ran_gumbel1 (const gsl_rng * r, const double a, const double b)
{
double x = gsl_rng_uniform_pos (r);
double z = (log(b) - log(-log(x))) / a;
return z;
}
double
gsl_ran_weibull (const gsl_rng * r, const double a, const double b)
{
double x = gsl_rng_uniform_pos (r);
double z = pow (-log (x), 1 / b);
return a * z;
}
static inline double rn_uniform_zero_to_one(struct _flow *flow)
{
#ifdef HAVE_LIBGSL
gsl_rng * r = flow->r;
return gsl_rng_uniform_pos(r);
#else
return rn_uniform(flow)/(RANDOM_MAX+1.0);
#endif /* HAVE_LIBGSL */
}
double
gsl_ran_gumbel2 (const gsl_rng * r, const double a, const double b)
{
double x = gsl_rng_uniform_pos (r);
double z = pow(-b / log(x), 1/a);
return z;
}
/*
Diese Funktion berechnet Nischenwerte für S Spezies. Dabei wird zunächst jeder Spezies eine Zufallszahl zugeordnet, der Nischenwert.
Dieser ist gleichverteilt auf ]0,1[. Ausgehend davon wird dann ein Fresszentrum und ein Fressbereich bestimmt.
Der Fressbereich wird mit einer Beta-Verteilung erwürfelt.
Eine Spezies kann eine andere Spezies fressen, wenn der Nischenwert der Beute im Fressbereich des Räubers liegt.
Rückgabewert: 3xS Matrix mit [0][S]: Nischenwert, [1][S]: Fressbereich, [2][S]: Fresszentrum.
*/
gsl_matrix *SetNicheValues(struct foodweb nicheweb, double C, gsl_rng* rng1, const gsl_rng_type* rng_T){
int S = nicheweb.S;
//printf("\nStarte Berechnung der Nischenwerte für %i Spezies\n", S);
gsl_matrix *NV = gsl_matrix_calloc(3, nicheweb.S);
gsl_vector *nv = gsl_vector_calloc(S);
//printf("nischenwert allokation");
double disbeta = (1-2*C)/(2*C); // Für den Fressbereich (Beta-Verteilung)
int i = 0;
//--Nischenwerte ausrechnen------------------------------------------------------------------------------------------------
for(i= 0; i<S; i++)
gsl_vector_set(nv, i, gsl_rng_uniform_pos(rng1)); // Nischenwerte gleichverteilt auf ]0,1[
gsl_sort_vector(nv); // Sortieren für Massenberechnung später
for(i = 0; i < S; i++)
{
double nvi = gsl_vector_get(nv, i);
double fri = gsl_ran_beta(rng1, 1, disbeta);
double rand = gsl_rng_uniform_pos(rng1);
double fci = nvi*fri*rand/2 + nvi*(1-rand); // Zufälliges Fresszentrum in [nv(i)*fr(i)/2, nv(i)]
gsl_matrix_set(NV, 0, i, nvi);
gsl_matrix_set(NV, 1, i, fri);
gsl_matrix_set(NV, 2, i, fci);
}
//--Zuweisung----------------------------------------------------------------------------------------------------
free(nv);
return NV;
}//end SetNicheValues
double
gsl_ran_gamma_mt (const gsl_rng * r, const double a, const double b)
{
/* assume a > 0 */
if (a < 1)
{
double u = gsl_rng_uniform_pos (r);
return gsl_ran_gamma_mt (r, 1.0 + a, b) * pow (u, 1.0 / a);
}
{
double x, v, u;
double d = a - 1.0 / 3.0;
double c = (1.0 / 3.0) / sqrt (d);
while (1)
{
do
{
x = gsl_ran_gaussian_ziggurat (r, 1.0);
v = 1.0 + c * x;
}
while (v <= 0);
v = v * v * v;
u = gsl_rng_uniform_pos (r);
if (u < 1 - 0.0331 * x * x * x * x)
break;
if (log (u) < 0.5 * x * x + d * (1 - v + log (v)))
break;
}
return b * d * v;
}
}
static void
random_point (double x[], coord bin[], double *bin_vol,
const coord box[], const double xl[], const double xu[],
gsl_monte_vegas_state * s, gsl_rng * r)
{
/* Use the random number generator r to return a random position x
in a given box. The value of bin gives the bin location of the
random position (there may be several bins within a given box) */
double vol = 1.0;
size_t j;
size_t dim = s->dim;
size_t bins = s->bins;
size_t boxes = s->boxes;
DISCARD_POINTER(xu); /* prevent warning about unused parameter */
for (j = 0; j < dim; ++j)
{
/* box[j] + ran gives the position in the box units, while z
is the position in bin units. */
double z = ((box[j] + gsl_rng_uniform_pos (r)) / boxes) * bins;
int k = z;
double y, bin_width;
bin[j] = k;
if (k == 0)
{
bin_width = COORD (s, 1, j);
y = z * bin_width;
}
else
{
bin_width = COORD (s, k + 1, j) - COORD (s, k, j);
y = COORD (s, k, j) + (z - k) * bin_width;
}
x[j] = xl[j] + y * s->delx[j];
vol *= bin_width;
}
*bin_vol = vol;
}
/* ----------------------------------------------------------------------- */
double SIMPLE_Agents::pinkq( int index ){
if(medium_term[index] == 0.0 )
medium_term[index] = gsl_rng_uniform_pos(GSL_randon_generator::r_rand);
else if( gsl_rng_uniform_pos(GSL_randon_generator::r_rand) < prob_medium_term_change )
medium_term[index] = gsl_rng_uniform_pos(GSL_randon_generator::r_rand);
if(long_term[index] == 0.0 )
long_term[index] = gsl_rng_uniform_pos(GSL_randon_generator::r_rand);
else if( gsl_rng_uniform_pos(GSL_randon_generator::r_rand) < prob_long_term_change )
long_term[index] = gsl_rng_uniform_pos(GSL_randon_generator::r_rand);
return (long_term[index] + medium_term[index] + gsl_rng_uniform_pos(GSL_randon_generator::r_rand) )/3.0;
}
double
gsl_ran_logistic (const gsl_rng * r, const double a)
{
double x, z;
do
{
x = gsl_rng_uniform_pos (r);
}
while (x == 1);
z = log (x / (1 - x));
return a * z;
}
double SIMPLE_Agents::get_randb_reading( vector <double> _to_robot_pos, vector <double> &_reading){
double work_range = 0.6;
randb_from = btVector3(0.0,0.0,0.0);
randb_to = btVector3(0.0,0.0,0.0);
this->pos = this->get_pos();
// get the distance between your robot and to destination robot "_to_robot_pos"
double range = sqrt(((_to_robot_pos[0]-pos[0])*(_to_robot_pos[0]-pos[0]) + (_to_robot_pos[2]-pos[2])*(_to_robot_pos[2]-pos[2])));
if(range < work_range){
_reading[0] = range;
// get the robot orienation
btMatrix3x3 m = btMatrix3x3(body->getWorldTransform().getRotation());
double rfPAngle = btAsin(-m[1][2]);
if(rfPAngle < SIMD_HALF_PI){
if(rfPAngle > -SIMD_HALF_PI) this->rotation = btAtan2(m[0][2],m[2][2]);
else this->rotation = -btAtan2(-m[0][1],m[0][0]);
}
else this->rotation = btAtan2(-m[0][1],m[0][0]);
// check the collision accross the distance between your robot and destination robot
randb_from = btVector3(_to_robot_pos[0],_to_robot_pos[1]+0.025,_to_robot_pos[2]);
randb_to = btVector3(pos[0], pos[1]+0.025, pos[2]);
btCollisionWorld::ClosestRayResultCallback res(randb_from, randb_to);
this->world->rayTest(randb_from, randb_to, res);
if(res.hasHit()){
World_Entity* object = (World_Entity*) res.m_collisionObject->getUserPointer();
if(object->get_type_id() == ROBOT && object->get_index() == this->index){
double bearing,nest_angle,robot_angle;
robot_angle =rotation;
if(robot_angle<0.0)
robot_angle = TWO_PI + robot_angle;
nest_angle = -atan2(_to_robot_pos[2]-pos[2], _to_robot_pos[0]-pos[0]);
if(nest_angle <0.0)
nest_angle = TWO_PI + nest_angle;
bearing = nest_angle - robot_angle;
if(bearing < 0.0)
bearing = TWO_PI + bearing;
//if you want to add noise bearing
bearing += (gsl_rng_uniform_pos( GSL_randon_generator::r_rand )*0.30 - 0.15);
_reading[1] = bearing;
}
randb_to =res.m_hitPointWorld;
}
}
}
unsigned int
gsl_ran_geometric (const gsl_rng * r, const double p)
{
double u = gsl_rng_uniform_pos (r);
unsigned int k;
if (p == 1)
{
k = 1;
}
else
{
k = log (u) / log (1 - p) + 1;
}
return k;
}
static void
ran_dirichlet_small (const gsl_rng * r, const size_t K,
const double alpha[], double theta[])
{
size_t i;
double norm = 0.0, umax = 0;
for (i = 0; i < K; i++)
{
double u = log(gsl_rng_uniform_pos (r)) / alpha[i];
theta[i] = u;
if (u > umax || i == 0) {
umax = u;
}
}
for (i = 0; i < K; i++)
{
theta[i] = exp(theta[i] - umax);
}
for (i = 0; i < K; i++)
{
theta[i] = theta[i] * gsl_ran_gamma (r, alpha[i] + 1.0, 1.0);
}
for (i = 0; i < K; i++)
{
norm += theta[i];
}
for (i = 0; i < K; i++)
{
theta[i] /= norm;
}
}
void Model::simulate(std::vector<double> & model_params, std::vector<std::string> & param_names, Trajectory * traj, int start_dt, int end_dt, double step_size, int total_dt, gsl_rng * rng) {
if ((traj->get_state(0)+traj->get_state(1)) < 1.0) {
return;
}
double R0_0=1.0;
double R0_1=1.0;
double R0_2=1.0;
double R0_3=1.0;
double R0_4=1.0;
double R0_5=1.0;
double R0_T0=0.0;
double R0_T1=100000.0;
double R0_T2=100000.0;
double R0_T3=100000.0;
double R0_T4=100000.0;
double k=1.0;
double alpha=1.0;
double scale=1.0;
// /* For slightly faster implementation, call parameters by index
for (int i=0; i!=param_names.size(); ++i) {
if (param_names[i]=="R0_0") R0_0 = model_params[i];
if (param_names[i]=="R0_1") R0_1 = model_params[i];
if (param_names[i]=="R0_2") R0_2 = model_params[i];
if (param_names[i]=="R0_3") R0_0 = model_params[i];
if (param_names[i]=="R0_4") R0_0 = model_params[i];
if (param_names[i]=="R0_5") R0_0 = model_params[i];
if (param_names[i]=="R0_T0") R0_T0 = model_params[i];
if (param_names[i]=="R0_T1") R0_T1 = model_params[i];
if (param_names[i]=="R0_T2") R0_T2 = model_params[i];
if (param_names[i]=="R0_T3") R0_T3 = model_params[i];
if (param_names[i]=="R0_T4") R0_T4 = model_params[i];
if (param_names[i]=="k") k = model_params[i];
if (param_names[i]=="alpha") alpha = model_params[i];
if (param_names[i]=="scale") scale = model_params[i];
}
double R0_now = 0.0;
double recoveries=0.0;
double new_infections=0.0;
double durI = 0.0;
double ran_unif_num1, ran_unif_num2;
if (custom_prob.size()==0) set_custom_prob(alpha, scale);
if (start_dt < step_size) { // Set initial number of infected
traj->resize_recoveries(total_dt);
int init_inf = (int)round(model_params[14]);
traj->set_state(init_inf, 0);
for (int i=0; i!=init_inf; ++i) {
// durI = gsl_ran_gamma(rng, alpha, scale);
ran_unif_num1 = gsl_ran_flat(rng, 0.0000001, 1);
ran_unif_num2 = gsl_ran_flat(rng, 0.0000001, 1);
durI = -log(ran_unif_num1)*scale-log(ran_unif_num2)*scale;
durI = (int)(durI/365.0/step_size);
traj->add_recovery_time(durI);
}
}
double num_infected = traj->get_state(0);
for (int t=start_dt; t<end_dt; ++t) {
//
// Transitions
//
// Recoveries: I --> R
recoveries = traj->num_recover_at(t-start_dt);
if (recoveries > 100000.0) { // If the epidemic is too large, set num_infected to 0, so that likelihood is 0.
num_infected = 0.0;
traj->set_traj(0.0, t-start_dt);
}
else if (recoveries > 0) {
traj->set_traj(recoveries, t-start_dt);
if (t*step_size<(R0_T0)) R0_now = R0_0;
else if (t*step_size<(R0_T1)) R0_now = R0_1;
else if (t*step_size<(R0_T2)) R0_now = R0_2;
else if (t*step_size<(R0_T3)) R0_now = R0_3;
else if (t*step_size<(R0_T4)) R0_now = R0_4;
else {
R0_now = R0_5;
}
new_infections = gsl_ran_negative_binomial(rng, k/(k+R0_now), k*recoveries);
if (new_infections > 1000) {
std::vector <unsigned int> a (106, 0);
gsl_ran_multinomial(rng, 106, (unsigned int)new_infections, &custom_prob[0], &a[0]);
for (int i=0; i!=a.size(); ++i) {
// durI = gsl_ran_gamma(rng, alpha, scale);
// ran_unif_num1 = gsl_rng_uniform_pos(rng);
// ran_unif_num2 = gsl_rng_uniform_pos(rng);
// durI = -log(ran_unif_num1)*scale-log(ran_unif_num2)*scale;
// durI = (int)(durI/365.0/step_size);
// durI = durI_vec[gsl_rng_uniform_int(rng, 1000)];
// traj->add_recovery_time(durI+t-start_dt);
traj->add_recovery_time(i+t-start_dt, a[i]);
}
}
else if (new_infections > 0) {
for (int i=0; i!=new_infections; ++i) {
ran_unif_num1 = gsl_rng_uniform_pos(rng);
ran_unif_num2 = gsl_rng_uniform_pos(rng);
durI = -log(ran_unif_num1)*scale-log(ran_unif_num2)*scale;
durI = (int)(durI/365.0/step_size);
traj->add_recovery_time(durI+t-start_dt);
}
}
num_infected += new_infections - recoveries;
}
double curr_coal_rate = 1.0/num_infected;
// Record 1/N for coalescent rate calculation
if (num_infected > 0.0) {
traj->set_traj2(curr_coal_rate*R0_now/(alpha*scale)*(1.0+1.0/k), t-start_dt);
}
else {
traj->set_traj2(0.0, t-start_dt);
break;
}
}
traj->set_state(num_infected, 0);
traj->delete_recoveries_before(end_dt-start_dt);
}
///Previous method:
double PoissonSource::getDelayUntilNextEvent()
{
double mu = (double)(1.0/(mlamda)); //Probability of spike event
double u = gsl_rng_uniform_pos (rng_r); //This returns a non-zero probability less that 1
return -mu * log (u);
}
int NBinGlm::nbinfit(gsl_matrix *Y, gsl_matrix *X, gsl_matrix *O, gsl_matrix *B)
{
gsl_set_error_handler_off();
initialGlm(Y, X, O, B);
gsl_rng *rnd=gsl_rng_alloc(gsl_rng_mt19937);
unsigned int i, j; //, isConv;
double yij, mij, vij, hii, uij, wij, wei;
double th, tol, dev_th_b_old;
int status;
// gsl_vector_view b0j, m0j, e0j, v0j;
gsl_matrix *WX = gsl_matrix_alloc(nRows, nParams);
gsl_matrix *TMP = gsl_matrix_alloc(nRows, nParams);
gsl_matrix *XwX = gsl_matrix_alloc(nParams, nParams);
gsl_vector_view Xwi, Xi, vj, dj, hj;
for (j=0; j<nVars; j++) {
betaEst(j, maxiter, &tol, maxtol); //poisson
// Get initial theta estimates
iterconv[j]=0.0;
if (mmRef->estiMethod==CHI2) {
th = getDisper(j, 1.0);
while ( iterconv[j]<maxiter ) {
//printf("th=%.2f, iterconv[%d]=%d\n", th, j, iterconv[j]);
iterconv[j]++;
dev_th_b_old = dev[j];
betaEst(j, 1.0, &tol, th); // 1-step beta
th = getDisper(j, th)/th;
tol = ABS((dev[j]-dev_th_b_old)/(ABS(dev[j])+0.1));
if (tol<eps) break;
} }
else if (mmRef->estiMethod==NEWTON) {
th = thetaML(0.0, j, maxiter);
while ( iterconv[j]<maxiter ) {
iterconv[j]++;
dev_th_b_old = dev[j];
th = thetaML(th, j, maxiter2);
betaEst(j, maxiter2, &tol, th);
tol=ABS((dev[j]-dev_th_b_old)/(ABS(dev[j])+0.1));
if (tol<eps) break;
} }
else {
th = getfAfAdash(0.0, j, maxiter);
/* lm=0;
for (i=0; i<nRows; i++) {
yij = gsl_matrix_get(Y, i, j);
mij = gsl_matrix_get(Mu, i, j);
lm = lm + llfunc( yij, mij, th);
} */
while ( iterconv[j]<maxiter ) {
iterconv[j]++;
dev_th_b_old = dev[j];
betaEst(j, maxiter2, &tol, th);
th = getfAfAdash(th, j, 1.0);
tol=ABS((dev[j]-dev_th_b_old)/(ABS(dev[j])+0.1));
if (tol<eps) break;
}
}
if ((iterconv[j]==maxiter)&(mmRef->warning==TRUE))
printf("Warning: reached maximum itrations - negative binomial may NOT converge in the %d-th variable (dev=%.4f, err=%.4f, theta=%.4f)!\n", j, dev[j], tol, th);
// other properties based on mu and phi
theta[j] = th;
gsl_matrix_memcpy(WX, Xref);
ll[j]=0;
for (i=0; i<nRows; i++) {
yij = gsl_matrix_get(Y, i, j);
mij = gsl_matrix_get(Mu, i, j);
vij = varfunc( mij, th);
gsl_matrix_set(Var, i, j, vij);
wij = sqrt(weifunc(mij, th));
gsl_matrix_set(wHalf, i, j, wij);
gsl_matrix_set(Res, i, j, (yij-mij)/sqrt(vij));
ll[j] = ll[j] + llfunc( yij, mij, th);
// get PIT residuals for discrete data
wei = gsl_rng_uniform_pos (rnd); // wei ~ U(0, 1)
uij=wei*cdf(yij, mij, th);
if (yij>0) uij=uij+(1-wei)*cdf((yij-1),mij,th);
gsl_matrix_set(PitRes, i, j, uij);
// W^1/2 X
Xwi = gsl_matrix_row (WX, i);
gsl_vector_scale(&Xwi.vector, wij);
}
aic[j]=-ll[j]+2*(nParams+1);
// X^T * W * X
gsl_matrix_set_identity (XwX);
gsl_blas_dsyrk (CblasLower, CblasTrans, 1.0, WX, 0.0, XwX);
status=gsl_linalg_cholesky_decomp (XwX);
if (status==GSL_EDOM) {
if (mmRef->warning==TRUE)
printf("Warning: singular matrix in calculating pit-residuals. An eps*I is added to the singular matrix.\n");
gsl_matrix_set_identity (XwX);
gsl_blas_dsyrk (CblasLower, CblasTrans, 1.0, WX, mintol, XwX);
gsl_linalg_cholesky_decomp (XwX);
}
gsl_linalg_cholesky_invert (XwX); // (X'WX)^-1
// Calc varBeta
vj = gsl_matrix_column (varBeta, j);
dj = gsl_matrix_diagonal (XwX);
gsl_vector_memcpy (&vj.vector, &dj.vector);
// hii is diagonal element of H=X*(X'WX)^-1*X'*W
hj = gsl_matrix_column (sqrt1_Hii, j);
gsl_blas_dsymm(CblasRight,CblasLower,1.0,XwX,Xref,0.0,TMP); // X*(X'WX)^-1
for (i=0; i<nRows; i++) {
Xwi=gsl_matrix_row(TMP, i);
Xi=gsl_matrix_row(Xref, i);
wij=gsl_matrix_get(wHalf, i, j);
gsl_blas_ddot(&Xwi.vector, &Xi.vector, &hii);
gsl_vector_set(&hj.vector, i, MAX(mintol, sqrt(MAX(0, 1-wij*wij*hii))));
//printf("hii=%.4f, wij=%.4f, sqrt(1-wij*wij*hii)=%.4f\n", hii, wij, sqrt(1-wij*wij*hii));
}
} // end nVar for j loop
// gsl_matrix_div_elements (Res, sqrt1_Hii);
// subtractMean(Res);
gsl_matrix_free(XwX);
gsl_matrix_free(WX);
gsl_matrix_free(TMP);
gsl_rng_free(rnd);
return SUCCESS;
}
double randomico (const gsl_rng *w){
double X;
X=gsl_rng_uniform_pos(w);
return (X);
}
int PoissonGlm::EstIRLS(gsl_matrix *Y, gsl_matrix *X, gsl_matrix *O, gsl_matrix *B, double *a)
{
initialGlm(Y, X, O, B);
gsl_set_error_handler_off();
gsl_rng *rnd=gsl_rng_alloc(gsl_rng_mt19937);
unsigned int i, j;
int status;
double yij, mij, vij, wij, tol, hii, uij, wei;
gsl_vector_view Xwi, Xi, vj, hj, dj;
gsl_matrix *WX = gsl_matrix_alloc(nRows, nParams);
gsl_matrix *TMP = gsl_matrix_alloc(nRows, nParams);
gsl_matrix *XwX = gsl_matrix_alloc(nParams, nParams);
for (j=0; j<nVars; j++) {
if ( a!=NULL ) theta[j]=a[j];
// estimate mu and beta
iterconv[j] = betaEst(j, maxiter, &tol, theta[j]);
if ((mmRef->warning==TRUE)&(iterconv[j]==maxiter))
printf("Warning: EstIRLS reached max iterations, may not converge in the %d-th variable (dev=%.4f, err=%.4f)!\n", j, dev[j], tol);
gsl_matrix_memcpy (WX, X);
for (i=0; i<nRows; i++) {
mij = gsl_matrix_get(Mu, i, j);
// get variance
vij = varfunc( mij, theta[j] );
gsl_matrix_set(Var, i, j, vij);
// get weight
wij = sqrt(weifunc(mij, theta[j]));
gsl_matrix_set(wHalf, i, j, wij);
// get (Pearson) residuals
yij = gsl_matrix_get(Y, i, j);
gsl_matrix_set(Res, i, j, (yij-mij)/sqrt(vij));
// get PIT residuals for discrete data
wei = gsl_rng_uniform_pos (rnd); // wei ~ U(0, 1)
uij = wei*cdf(yij, mij, theta[j]);
if (yij>0) uij=uij+(1-wei)*cdf((yij-1),mij,theta[j]);
gsl_matrix_set(PitRes, i, j, uij);
// get elementry log-likelihood
ll[j] = ll[j] + llfunc( yij, mij, theta[j]);
// W^1/2 X
Xwi = gsl_matrix_row (WX, i);
gsl_vector_scale(&Xwi.vector, wij);
}
aic[j]=-ll[j]+2*(nParams);
// X^T * W * X
gsl_matrix_set_identity(XwX);
gsl_blas_dsyrk (CblasLower, CblasTrans, 1.0, WX, 0.0, XwX);
status=gsl_linalg_cholesky_decomp (XwX);
if (status==GSL_EDOM) {
if (mmRef->warning==TRUE)
printf("Warning: singular matrix in calculating pit-residuals. An eps*I is added to the singular matrix.\n");
gsl_matrix_set_identity(XwX);
gsl_blas_dsyrk (CblasLower, CblasTrans, 1.0, WX, mintol, XwX);
gsl_linalg_cholesky_decomp (XwX);
}
gsl_linalg_cholesky_invert (XwX);
// Calc varBeta
dj = gsl_matrix_diagonal (XwX);
vj = gsl_matrix_column (varBeta, j);
gsl_vector_memcpy (&vj.vector, &dj.vector);
// hii is diagonal element of H=X*(X'WX)^-1*X'*W
hj = gsl_matrix_column (sqrt1_Hii, j);
gsl_blas_dsymm(CblasRight,CblasLower,1.0,XwX,Xref,0.0,TMP); // X*(X'WX)^-1
for (i=0; i<nRows; i++) {
Xwi=gsl_matrix_row(TMP, i);
Xi=gsl_matrix_row(Xref, i);
wij=gsl_matrix_get(wHalf, i, j);
gsl_blas_ddot(&Xwi.vector, &Xi.vector, &hii);
gsl_vector_set(&hj.vector, i, MAX(mintol, sqrt(MAX(0, 1-wij*wij*hii))));
}
}
// standardize perason residuals by rp/sqrt(1-hii)
// gsl_matrix_div_elements (Res, sqrt1_Hii);
// subtractMean(Res); // have mean subtracted
gsl_matrix_free(XwX);
gsl_matrix_free(WX);
gsl_matrix_free(TMP);
gsl_rng_free(rnd);
return SUCCESS;
}
double runiform(double a, double b) {
// Returns uniform random variable on (a,b)
//return (a + (b-a)*gsl_rng_uniform(RANDOM_NUMBER));
return (a + (b-a)*gsl_rng_uniform_pos(RANDOM_NUMBER));
}
double d_rand(void)
{
return gsl_rng_uniform_pos(r);
}
virtual double getInterval()
{
return getPropensity()*
(-log(gsl_rng_uniform_pos(getStepper()->getRng())));
}
int diehard_3dsphere(Test **test, int irun)
{
int j,k;
C3_3D *c3;
double r1,r2,r3,rmin,r3min;
double xdelta,ydelta,zdelta;
/*
* for display only. Test dimension is 3, of course.
*/
test[0]->ntuple = 3;
r3min = 0;
/*
* This one should be pretty straightforward. Generate a vector
* of three random coordinates in the range 0-1000 (check the
* diehard code to see what "in" a 1000^3 cube means, but I'm assuming
* real number coordinates greater than 0 and less than 1000). Do
* a simple double loop through to float the smallest separation out.
* Generate p, save in a sample vector. Apply KS test.
*/
c3 = (C3_3D *)malloc(POINTS_3D*sizeof(C3_3D));
rmin = 2000.0;
for(j=0;j<POINTS_3D;j++){
/*
* Generate a new point in the cube.
*/
for(k=0;k<DIM_3D;k++) c3[j].x[k] = 1000.0*gsl_rng_uniform_pos(rng);
if(verbose == D_DIEHARD_3DSPHERE || verbose == D_ALL){
printf("%d: (%8.2f,%8.2f,%8.2f)\n",j,c3[j].x[0],c3[j].x[1],c3[j].x[2]);
}
/*
* Now compute the distance between the new point and all previously
* picked points.
*/
for(k=j-1;k>=0;k--){
xdelta = c3[j].x[0]-c3[k].x[0];
ydelta = c3[j].x[1]-c3[k].x[1];
zdelta = c3[j].x[2]-c3[k].x[2];
r2 = xdelta*xdelta + ydelta*ydelta + zdelta*zdelta;
r1 = sqrt(r2);
r3 = r2*r1;
if(verbose == D_DIEHARD_3DSPHERE || verbose == D_ALL){
printf("%d-%d: |(%6.2f,%6.2f,%6.2f)| = r1 = %f rmin = %f, \n",
j,k,xdelta,ydelta,zdelta,r1,rmin);
}
if(r1<rmin) {
rmin = r1;
r3min = r3;
}
}
}
MYDEBUG(D_DIEHARD_3DSPHERE) {
printf("Found rmin = %f (r^3 = %f)\n",rmin,r3min);
}
test[0]->pvalues[irun] = 1.0 - exp(-r3min/30.0);
MYDEBUG(D_DIEHARD_3DSPHERE) {
printf("# diehard_3dsphere(): test[0]->pvalues[%u] = %10.5f\n",irun,test[0]->pvalues[irun]);
}
nullfree(c3);
return(0);
}
int GSLRNG_uniform_pos(stEval *args, stEval *result, void *i) {
gsl_rng *r = STPOINTER(&args[0]);
STDOUBLE(result) = gsl_rng_uniform_pos(r);
return EC_OK;
}