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 ;
        }
    }
}
Exemple #2
0
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;
}
Exemple #4
0
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));
}
Exemple #5
0
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;
}
Exemple #6
0
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);
    }
}
Exemple #7
0
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);
}
Exemple #8
0
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));
}
Exemple #9
0
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;
}
Exemple #10
0
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;
}
Exemple #11
0
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 */
}
Exemple #12
0
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
Exemple #14
0
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;
  }
}
Exemple #15
0
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;
        }
    }
}
Exemple #19
0
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;
}
Exemple #20
0
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);
 }
Exemple #23
0
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;    
}
Exemple #24
0
double randomico (const gsl_rng *w){
	double X;	
	X=gsl_rng_uniform_pos(w);
	return (X);
}
Exemple #25
0
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;    
}
Exemple #26
0
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));
}
Exemple #27
0
 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);

}
Exemple #30
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;
}