Esempio n. 1
0
/* Uniform rejection sampling */
static R_INLINE double urs_a_b(double a, double b) {
  SAMPLER_DEBUG("urs_a_b", a, b);
  const double phi_a = dnorm(a, 0.0, 1.0, FALSE);
  double x = 0.0, u = 0.0;

  /* Upper bound of normal density on [a, b] */
  const double ub = a < 0 && b > 0 ? M_1_SQRT_2PI : phi_a;
  do {
    x = runif(a, b);
  } while (runif(0, 1) * ub > dnorm(x, 0, 1, 0));
  return x;
}
Esempio n. 2
0
inline T math_rand_normal(RNGType &rng)
{
    mckl::UniformRealDistribution<T> runif(
        static_cast<T>(-1e4), static_cast<T>(1e4));

    T f = runif(rng);
    if (f > 0)
        f += std::numeric_limits<T>::min();
    else
        f -= std::numeric_limits<T>::min();

    return f;
}
Esempio n. 3
0
void wsrewire_R(double *gi, double *go, double *pn, double *pnv, double *pp)
/*Perform a Watts-Strogatz rewiring process on the adjacency array pointed
to by *gi, storing the results in *go.  It is assumed that gi contains a 
*pn x *pnv *pnv array, whose non-null dyads are rewired (symmetrically) with
uniform probability *pp.  *go should be a copy of *gi.*/
{
  long int n,nv,i,j,k,h,t;
  double p,tempht,tempth;
  char flag;
  
  /*Take care of preliminaries*/
  n=(long int)*pn;
  nv=(long int)*pnv;
  p=*pp;
  GetRNGstate();

  /*Rewire the array*/
  for(i=0;i<n;i++){
    for(j=0;j<nv;j++){
      for(k=j+1;k<nv;k++){
        /*If the original dyad is non-null, rewire it w/prob p*/
        if(((gi[i+j*n+k*n*nv]!=0.0)||(gi[i+j*n+k*n*nv]!=0.0)) &&(runif(0.0,1.0)<p)){
          flag=0;
          while(!flag){
            t=j;  /*Save the head, tail*/
            h=k;
            if(runif(0.0,1.0)<0.5){   /*Switch head or tail w/50% prob*/
              h=(long int)floor(runif(0.0,1.0)*nv);
              if((h!=j)&&(h!=k)&&(go[i+t*n+h*n*nv]==0.0)&& (go[i+h*n+t*n*nv]==0.0)) /*Is h legal?*/
                flag++;
            }else{
              t=(long int)floor(runif(0.0,1.0)*nv);
              if((t!=j)&&(t!=k)&&(go[i+t*n+h*n*nv]==0.0)&& (go[i+h*n+t*n*nv]==0.0)) /*Is t legal?*/
                flag++;
            }
          }
          /*Swap the dyad states*/
          tempth=go[i+t*n+h*n*nv];
          tempht=go[i+h*n+t*n*nv];
          go[i+t*n+h*n*nv]=go[i+j*n+k*n*nv];
          go[i+h*n+t*n*nv]=go[i+k*n+j*n*nv];
          go[i+j*n+k*n*nv]=tempth;
          go[i+k*n+j*n*nv]=tempht;
        }
      }
    }    
  }
  /*Reset the random number generator*/
  PutRNGstate();
}
Esempio n. 4
0
  //----------------------------------------------------------------------
  // driver function to draw a single element of the correlation
  // matrix conditional on the variances.
  void SepStratSampler::draw_R(int i, int j){
    i_ = i;
    j_ = j;

    double oldr = R_(i,j);
    double slice = logp_slice_R(oldr) - rexp();
    find_limits();
    double rcand = runif(lo_, hi_);
    while(logp_slice_R(rcand) < slice && hi_ > lo_){
      if(rcand > oldr) hi_ = rcand;
      else lo_ = rcand;
      rcand = runif(lo_,hi_);
    }
    set_R(rcand);
  }
Esempio n. 5
0
void predictInterp(double *alpha, double *lambda, double *beta, double *predictPositions, int *NpredictPositions, double *diffPositionj, double *currPositionsj, double *currPositionsjp1, double *thetaj, double *thetajp1, double *predvals) {
  // Runs the prediction code when we are interpolating between two positions
  int Nd = rpois((*lambda)*(*diffPositionj));
  int i;
  double depthEvents[Nd];
  for(i=0;i<Nd;i++) depthEvents[i] = runif(*currPositionsj,*currPositionsjp1);
  R_rsort(depthEvents,Nd);
  double timeEventsUnsc[Nd+1],timeEventsSum=0.0;
  for(i=0;i<Nd+1;i++) timeEventsUnsc[i] = rgamma(*alpha,1/(*beta));
  for(i=0;i<Nd+1;i++) timeEventsSum += timeEventsUnsc[i];
  double timeEvents[Nd+1];
  for(i=0;i<Nd+1;i++) timeEvents[i] = (*thetajp1-*thetaj)*timeEventsUnsc[i]/timeEventsSum;
  double timeEventsCumsum[Nd+1],allTimeEvents[Nd+2];
  timeEventsCumsum[0] = 0.0;
  for(i=1;i<Nd+1;i++) timeEventsCumsum[i] = timeEventsCumsum[i-1] + timeEvents[i];
  for(i=0;i<Nd+1;i++) allTimeEvents[i] = timeEventsCumsum[i]+*thetaj;
  allTimeEvents[Nd+1] = *thetajp1;
  double allDepthEvents[Nd+2];
  allDepthEvents[0] = *currPositionsj;
  for(i=1;i<Nd+1;i++) allDepthEvents[i] = depthEvents[i-1];
  allDepthEvents[Nd+1] = *currPositionsjp1;
  
  int Ndp2 = Nd+2;
  for(i=0;i<*NpredictPositions;i++) {
    linInterp(&Ndp2,&predictPositions[i],allDepthEvents,allTimeEvents,&predvals[i]);
  }
}
Esempio n. 6
0
File: Utils.c Progetto: cran/mvst
void leftTruncNorm(double *mu, double *sigma2, double *x){
 int check1, check2;
 double alphaStar, u, muMinus, z;
 muMinus = -*mu/sqrt(*sigma2);
 if (muMinus <= 0.0){
  check1 = FALSE;
  while(check1 == FALSE){
   GetRNGstate();
   z = rnorm(0.0,1.0);
   PutRNGstate();
   check1 = (z > muMinus);
  }
 } else {
  alphaStar = 0.5 * (muMinus + sqrt(muMinus * muMinus + 4.0));
  check2 = FALSE;
  while(check2 == FALSE){
   GetRNGstate();
   z = muMinus + rexp(1/alphaStar);
   PutRNGstate();
   GetRNGstate();
   u = runif(0.0,1.0);
   PutRNGstate();
   check2 = (u <= exp(-0.5*(z-alphaStar) * (z-alphaStar)));
  }
 }
 *x = *mu + z * sqrt(*sigma2);
}
Esempio n. 7
0
int CGaussianMDP::multinomial(int ncell, double * nvec)
{
   /* draws just one from a multinomial distribution */
   int i, bindraw;
   double denom,tmp;
   
   /* draw multinomial via binomials */
   denom=0.0;
   
   for(i=0; i<ncell; i++)
      denom+=nvec[i];
   
   for(i=0; i<(ncell-1); i++) 
   {
      tmp = nvec[i]/denom;
      denom -= nvec[i];
      bindraw = runif(0.0,1.0)<=tmp;
      if(bindraw==1)
      {
         bindraw *= (i+1);
         return(bindraw);
      }
   }

   /* if 1,..,k-1 cells don't contain draw, then the last cell contains the draw*/
   bindraw = ncell;
   return(bindraw);
}
Esempio n. 8
0
/**
 * Simulate beta using the naive Gibbs update
 *
 * @param da an SEXP struct
 *
 */
static void sim_beta(SEXP da){
  int *dm = DIMS_SLOT(da), *k = K_SLOT(da);
  int nB = dm[nB_POS];
  double *beta = FIXEF_SLOT(da), *mh_sd = MHSD_SLOT(da), *l = CLLIK_SLOT(da), 
    *pm = PBM_SLOT(da), *pv = PBV_SLOT(da), *acc = ACC_SLOT(da);
  double xo, xn, l1, l2, A;

  /* initialize llik_mu*/
  *l = llik_mu(da);
  for (int j = 0; j < nB; j++){
    *k = j;
    xo = beta[j];
    xn = rnorm(xo, mh_sd[j]);
    l1 = *l;
    l2 = post_betak(xn, da);
    A = exp(l2 - l1 + 0.5 * (xo - pm[j]) * (xo - pm[j]) / pv[j]);
    /* determine whether to accept the sample */
    if (A < 1 && runif(0, 1) >= A){ /* not accepted */
      *l = l1;       /* revert the likelihood (this is updated in post_betak) */
    }
    else {
      beta[j] = xn;
      acc[j]++;    
    }
  }                  /* update the mean using the new beta */                    
  if (dm[nU_POS]) cpglmm_fitted(beta, 1, da);
  else cpglm_fitted(beta, da);  
}
Esempio n. 9
0
static void nosort_resamp (int nw, double *w, int np, int *p, int offset) 
{
  int i, j;
  double du, u;

  for (j = 1; j < nw; j++) w[j] += w[j-1];

  if (w[nw-1] <= 0.0)
    error("non-positive sum of weights");

  du = w[nw-1] / ((double) np);
  u = runif(-du,0);

  for (i = 0, j = 0; j < np; j++) {   
    u += du;
    while (u > w[i]) i++;
    p[j] = i;
      
    
  }
 
if (offset)      // add offset if needed
    for (j = 0; j < np; j++) p[j] += offset;

}
Esempio n. 10
0
int random(int a)
{
  GetRNGstate();
  int f = (int) runif(0, a);
  PutRNGstate();
  return f;
};
Esempio n. 11
0
double moaftme_sample_int_censored(double tl,
        double tu,
        double mean,
        double sigma) {
    //plnorm args: x, mean, sigma, lowertail=TRUE, log=FALSE
    double Fl = plnorm(tl, mean, sigma, 1, 0);
    if (Fl > (1 - 1e-8)) {
        // tl is very large and both f(tl) and f(tu) are very small.
        // qlnorm would return Inf. We sample uniformly from [tl, tu]. 
        return runif(tl, tu);
    }
    double Fu = plnorm(tu, mean, sigma, 1, 0);
    double Fw = runif(Fl, Fu);
    return qlnorm(Fw, mean, sigma, 1, 0);
    //Rprintf("i %f\n", w[i]);
}
Esempio n. 12
0
		int rdunif(int n){
			int ret = 0;
			GetRNGstate();
			ret = (int) floor(n * runif(0, 1));
			PutRNGstate();
			return(ret);
		}
Esempio n. 13
0
// [[Rcpp::export]]
IntegerVector bootPerm(const int n) {
    RNGScope scope;
    NumericVector unRound(runif(n, 0, n));
    NumericVector rounded(floor(unRound));
    IntegerVector out = Rcpp::as< IntegerVector >(rounded);
    return out;
}
Esempio n. 14
0
// Function that computes the relative frequencies of the first digits of a random number satisfying benfords law
double rpbenf(double *r_pbenf, int *combfdigits, double *qbenfvals, int *n)
{
   int i,j;
   double random_x;
   
//   GetRNGstate();
   //set r_pbenf to zeros
   for (j = 0; j< combfdigits[0]; j++)
   {
      r_pbenf[j] = 0;
   }
   for (i = 0; i < n[0]; i++)
   {
      random_x = runif(0,1);
      
      for (j = 0; j< combfdigits[0]; j++)
      {
         if(random_x<=qbenfvals[j])
         {
            r_pbenf[j] = r_pbenf[j]+1;
            break;
         }
      }
   }
   for (j = 0; j< combfdigits[0]; j++)
   {
      r_pbenf[j] = r_pbenf[j]/n[0];
   }
//   PutRNGstate();
   return(*r_pbenf);
}
Esempio n. 15
0
static void sim_u(SEXP da){
  int *dm = DIMS_SLOT(da), *k = K_SLOT(da);
  int nB = dm[nB_POS], nU = dm[nU_POS];
  double *u = U_SLOT(da), *l = CLLIK_SLOT(da), 
    *mh_sd = MHSD_SLOT(da) + nB + 2, /* shift the proposal variance pointer */
    *acc = ACC_SLOT(da) + nB + 2;    /* shift the acc pointer */
  double xo, xn, l1, l2, A;

  /* initialize llik_mu*/
  *l = llik_mu(da);
  for (int j = 0; j < nU; j++){
    *k = j ;
    xo = u[j];
    xn = rnorm(xo, mh_sd[j]);
    l1 = *l;
    l2 = post_uk(xn, da);
    A = exp(l2 - (l1 + prior_uk(xo, da)));  
    /* determine whether to accept the sample */
    if (A < 1 && runif(0, 1) >= A){ 
      *l = l1;  /* revert llik_mu (this is updated in post_uk) */
    }
    else{
      u[j] = xn;
      acc[j]++;    
    }
  }
  cpglmm_fitted(u, 0, da) ;  /* update the mean using the new u */
}
Esempio n. 16
0
cs *cs_rR(const cs *A, double nu, double nuR, const css *As, const cs *Roldinv, double Roldldet, const cs *pG){
    
	cs *Rnew, *Rnewinv, *Ainv;
	double Rnewldet, MH;
        int dimG = A->n;
	int cnt = 0;
	int i, j;
	
	Rnewinv = cs_spalloc (dimG, dimG, dimG*dimG, 1, 0);
	
	for (i = 0 ; i < dimG; i++){
	  Rnewinv->p[i] = i*dimG;
	  for (j = 0 ; j < dimG; j++){
		Rnewinv->i[cnt] = j;
		Rnewinv->x[cnt] = 0.0;
                A->x[i*dimG+j] -= pG->x[i*dimG+j];
 		cnt++;
	  }
	}
	Rnewinv->p[dimG] = dimG*dimG;
		
	cs_cov2cor(A);
	Ainv = cs_inv(A);
	
	Rnew = cs_rinvwishart(Ainv, nu, As);	
	cs_cov2cor(Rnew);
		
	Rnewldet = log(cs_invR(Rnew, Rnewinv));

/*****************************************************/
/*       From Eq A.4 in Liu and Daniels (2006)       */
/*       using \pi_{1} = Eq 6 in Barnard (2000)      */
/*  using \pi_{2} = Eq 3.4 in Liu and Daniels (2006) */
/*****************************************************/

        MH = Roldldet-Rnewldet;
 
	for (i = 0 ; i < dimG; i++){
          MH += log(Roldinv->x[i*dimG+i]);
          MH -= log(Rnewinv->x[i*dimG+i]);
	}

	MH *= 0.5*nuR;

	if(MH<log(runif(0.0,1.0)) || Rnewldet<log(Dtol)){
	  Rnewldet = cs_invR(Roldinv, Rnew);	// save old R	
        }

        for (i = 0 ; i < dimG; i++){
          for (j = 0 ; j < dimG; j++){
 	    Rnew->x[i*dimG+j] *= sqrt((pG->x[i*dimG+i])*(pG->x[j*dimG+j]));
          }
        }

        cs_spfree(Rnewinv);
        cs_spfree(Ainv);

    return (cs_done (Rnew, NULL, NULL, 1)) ;	/* success; free workspace, return C */

}
Esempio n. 17
0
  // This function is supposed to draw a random correlation matrix
  // from the uniform distribution on the space of all correlation
  // matrices.  It is broken
    CM random_cor(uint n){
      CM R(n);
      for(int k = 0; k < 1; ++k){
        for(int i = 0; i < n-1; ++i){
          for(int j = i+1; j < n; ++j){
            Rdet f(R, i, j);
            double f1 = f(1);
            double fn = f(-1);
            double f0 = f(0);
            double a = .5 * (f1 + fn - 2*f0);
            double b = .5 * (f1 - fn);
            double c = f0;

            double d2 = b*b - 4 * a * c;
            if(d2 < 0){
              R(i,j) = 0;
              R(j,i) = 0;
              continue;
            }
            double d = std::sqrt(d2);
            double lo = (-b - d)/(2*a);
            double hi = (-b + d)/(2*a);
            if(a < 0) std::swap(lo, hi);
            double r = runif(lo, hi);
            R(i,j) = r;
            R(j,i) = r;
          }
        }
      }
      return R;
    }
Esempio n. 18
0
static void test_set_deta_rand(double min, double max)
{
	size_t n = catdist1_ncat(&CATDIST1);
	size_t i = rand() % n;
	double deta = runif(min, max);
	test_set_deta(i, deta);
	
}
Esempio n. 19
0
void BAFT_LNsurv_update_sigSq(gsl_vector *yL,
                              gsl_vector *yU,
                              gsl_vector *yU_posinf,
                              gsl_vector *c0,
                              gsl_vector *c0_neginf,
                              gsl_matrix *X,
                              gsl_vector *y,
                              gsl_vector *beta,
                              double beta0,
                              double *sigSq,
                              double a_sigSq,
                              double b_sigSq,
                              double sigSq_prop_var,
                              int *accept_sigSq)
{
    int i, u;
    double eta, loglh, loglh_prop, logR, gamma_prop, sigSq_prop;
    double logprior, logprior_prop;
    
    int n = X -> size1;
    gsl_vector *xbeta = gsl_vector_calloc(n);
    
    loglh = 0;
    loglh_prop = 0;
    gamma_prop = rnorm(log(*sigSq), sqrt(sigSq_prop_var));
    sigSq_prop = exp(gamma_prop);
    gsl_blas_dgemv(CblasNoTrans, 1, X, beta, 0, xbeta);
    
    for(i=0;i<n;i++)
    {
        eta = beta0 + gsl_vector_get(xbeta, i);
        if(gsl_vector_get(c0_neginf, i) == 0)
        {
            loglh += dnorm(gsl_vector_get(y, i), eta, sqrt(*sigSq), 1) - pnorm(gsl_vector_get(c0, i), eta, sqrt(*sigSq), 0, 1);
            loglh_prop += dnorm(gsl_vector_get(y, i), eta, sqrt(sigSq_prop), 1) - pnorm(gsl_vector_get(c0, i), eta, sqrt(sigSq_prop), 0, 1);
        }else
        {
            loglh += dnorm(gsl_vector_get(y, i), eta, sqrt(*sigSq), 1);
            loglh_prop += dnorm(gsl_vector_get(y, i), eta, sqrt(sigSq_prop), 1);
        }        
    }
    
    logprior = (-a_sigSq-1)*log(*sigSq)-b_sigSq /(*sigSq);
    logprior_prop = (-a_sigSq-1)*log(sigSq_prop)-b_sigSq/sigSq_prop;
    
    logR = loglh_prop - loglh + logprior_prop - logprior + gamma_prop - log(*sigSq);
    
    u = log(runif(0, 1)) < logR;
    
    if(u == 1)
    {
        *sigSq = sigSq_prop;
        *accept_sigSq += 1;
    }
    
    gsl_vector_free(xbeta);
    return;
}
Esempio n. 20
0
void STGM::CBoolSphereSystem::simSpheres(F f, const char *label) {
  int nTry = 0;
  while(num==0 && nTry<MAX_ITER) {
        num = rpois(m_box.volume()*m_lam);
        ++nTry;
  }
  m_spheres.reserve(num);

  double m[3] = {m_box.m_size[0]+m_box.m_low[0],
                 m_box.m_size[1]+m_box.m_low[1],
                 m_box.m_size[2]+m_box.m_low[2]};

  /* loop over all */
  for (size_t niter=0;niter<num; niter++) {
      STGM::CVector3d center(runif(0.0,1.0)*m[0],runif(0.0,1.0)*m[1],runif(0.0,1.0)*m[2]);
      m_spheres.push_back( STGM::CSphere(center, f(), m_spheres.size()+1,label));
  }
}
Esempio n. 21
0
 std::vector<uint> Resampler::operator()(uint N)const{
   std::vector<uint> ans(N);
   for(uint i=0; i<N; ++i){
     double u = runif();
     uint indx = cdf.lower_bound(u)->second;
     ans[i] = indx;
   }
   return ans;
 }
Esempio n. 22
0
void rtruncn(double *a, double *b, double *x) {
  double A, B;
  double maxA, maxB, maxR, r2, r, th, u, v, accept=0.0;
  A = atan(*a);
  B = atan(*b);
  maxA = exp(-pow(*a,2)/4)/cos(A);
  maxB = exp(-pow(*b,2)/4)/cos(B);
  maxR = fmax2(maxA, maxB);
  if((*a<1) && (*b>-1)) maxR = exp(-0.25)*sqrt(2.0);
  while (accept==0) {
    r2 = runif(0.0,1.0);
    r = sqrt(r2)*maxR;
    th = runif(A,B);
    u = r*cos(th);
    *x = tan(th);
    accept = ((pow(*x,2)) < (log(u)*-4));
  }
}
Esempio n. 23
0
  void Cfunc(double *xvec, int *xlen, int *M, double *beta0, double *alpha, double *res) {

    //    double qt(double p, double ndf, int lower_tail,int log_p);
    //    double runif(double a, double b);
    int d = 0, m, i, n = xlen[0];
    double *yvec;
    yvec = new double[n];
    double meanxy = 0.0, meanx = 0.0, meany = 0.0, meanx2 = 0.0, meany2 = 0.0;
    double thresh, num = 0.0, denom = 0.0, tobs, beta1hat, beta0hat, sighat, sighatbeta1hat;
    thresh = qt(1.0 - alpha[0] / 2.0, (double)(n - 2), 1, 0);
    //   Rprintf("Value of thresh: %g", thresh);
    //   Rprintf("\n");

    for (i = 0; i < n; i++) {
      meanx = meanx + xvec[i];
      meanx2 = meanx2 + R_pow(xvec[i], 2.0);
    }
    meanx = meanx / (double)n;
    meanx2 = meanx2 / (double)n;

    GetRNGstate();
    for (m = 0; m < M[0]; m++) {
      meany = 0;
      meany2 = 0;
      meanxy = 0;
      for (i = 0; i < n; i++) { 
	yvec[i] = beta0[0] + runif(0.0, 1.0);
	meany = meany + yvec[i];
	meany2 = meany2 + R_pow(yvec[i], 2.0);
	meanxy = meanxy + xvec[i] * yvec[i]; 
      }
      meany = meany / (double)n;
      meany2 = meany2 / (double)n;
      meanxy = meanxy / (double)n;
      
      num = meanxy - meanx * meany;
      denom = meanx2 - meanx * meanx;
      
      beta1hat = num / denom;
      beta0hat = meany - beta1hat * meanx;
      
      sighat = sqrt((double)n * (meany2 + beta0hat * beta0hat + beta1hat * beta1hat * meanx2 - 2.0 * beta0hat * meany
				 - 2.0 * beta1hat * meanxy + 2.0 * beta0hat * beta1hat * meanx) / (double)(n - 2));
      
      sighatbeta1hat = sighat / sqrt((double)n * denom);
      
      tobs = beta1hat / sighatbeta1hat;
      
      if (fabs(tobs) > thresh) d = d + 1;
    }

    PutRNGstate();
    res[0] = (double)d / (double)M[0];
    
    delete[] yvec;
  }	// End of Cfunc
Esempio n. 24
0
/* Exponential rejection sampling (a,b) */
static R_INLINE double ers_a_b(double a, double b) {
  SAMPLER_DEBUG("ers_a_b", a, b);
  const double ainv = 1.0 / a;
  double x, rho;
  do {
    x = rexp(ainv) + a; /* rexp works with 1/lambda */
    rho = exp(-0.5 * pow((x - a), 2));
  } while (runif(0, 1) > rho || x > b);
  return x;
}
Esempio n. 25
0
/* Exponential rejection sampling (a,inf) */
static R_INLINE double ers_a_inf(double a) {
  SAMPLER_DEBUG("ers_a_inf", a, R_PosInf);
  const double ainv = 1.0 / a;
  double x, rho;
  do {
    x = rexp(ainv) + a; /* rexp works with 1/lambda */
    rho = exp(-0.5 * pow((x - a), 2));
  } while (runif(0, 1) > rho);
  return x;
}
Esempio n. 26
0
void udrewire_R(double *g, double *pn, double *pnv, double *pp)
/*Perform a uniform rewiring process on the adjacency array pointed
to by *g.  It is assumed that g contains a *pn x *pnv *pnv array, whose dyads
are rewired (symmetrically) with uniform probability *pp.*/
{
  long int n,nv,i,j,k,h,t;
  double p,tempht,tempth;
  
  /*Take care of preliminaries*/
  n=(long int)*pn;
  nv=(long int)*pnv;
  p=*pp;
  GetRNGstate();

  /*Rewire the array*/
  for(i=0;i<n;i++){
    for(j=0;j<nv;j++){
      for(k=j+1;k<nv;k++){
        /*Rewire w/prob p*/
        if(runif(0.0,1.0)<p){
          t=j;  /*Save the head, tail*/
          h=k;
          if(runif(0.0,1.0)<0.5){   /*Switch head or tail w/50% prob*/
            while((h==j)||(h==k)) /*Draw h until legal*/
              h=(long int)floor(runif(0.0,1.0)*nv);
          }else{
            while((t==j)||(t==k)) /*Draw t until legal*/
              t=(long int)floor(runif(0.0,1.0)*nv);
          }
          /*Swap the dyad states*/
          tempth=g[i+t*n+h*n*nv];
          tempht=g[i+h*n+t*n*nv];
          g[i+t*n+h*n*nv]=g[i+j*n+k*n*nv];
          g[i+h*n+t*n*nv]=g[i+k*n+j*n*nv];
          g[i+j*n+k*n*nv]=tempth;
          g[i+k*n+j*n*nv]=tempht;
       }
      }
    }    
  }
  /*Reset the random number generator*/
  PutRNGstate();
}
Esempio n. 27
0
int Model::run(std::mt19937 &rng, const Eigen::MatrixXd &S,
               const Eigen::MatrixXd &C, const Eigen::MatrixXd &M,
               const Eigen::MatrixXd &W, const Parameter &parameter,
               const unsigned int max_iter) {

  std::uniform_int_distribution<int> runif(0, n_dimensions - 1);
  std::normal_distribution<double> rnorm(0.0, 1.0);

  Eigen::MatrixXd V(n_alternatives, 1);
  V.setZero();
  Eigen::MatrixXd P(n_alternatives, 1);
  P.setZero();

  unsigned int dim;
  unsigned int iter = 0;
  Eigen::MatrixXd noise(n_alternatives, 1);

  do {
    dim = runif(rng);

    for (unsigned int i = 0; i < n_alternatives; i++) {
      noise(i, 0) = rnorm(rng);
    }

    V = C * M * W.col(dim) + parameter.sig2 * C * noise;
    P = S * P + V;

    iter++;

  } while ((P.maxCoeff() < parameter.theta) && (iter < max_iter));

  int winner;

  if (iter < max_iter) {
    Eigen::MatrixXd::Index row, col;
    P.maxCoeff(&row, &col);
    winner = row;
  } else {
    winner = -1;
  }

  return winner;
}
Esempio n. 28
0
/** 
 * 
 * 
 * @param N number of samples
 * @param theta mutation rate
 * @param Tb "bottleneck" time
 * @param f fraction of bottleneck population compared to current
 * 
 * @return root node
 * 
 */
struct Node *coalescent_tree(unsigned int N, double theta, double Tb, double f)
{
	// http://users.stat.umn.edu/~geyer/rc/
	GetRNGstate();
	int k;
	unsigned int i, j, n_nodes;
	// there are 2N-2 branches (rooted tree), which implies 2N-1 nodes
	n_nodes = 2*N - 1;
	struct Node *nodes[n_nodes];
	for (k=0; k < n_nodes; k++)
		nodes[k] = new_node(k);
	
	double rate, Ti, Ttot;
	Ttot = 0.0;
	i = j = N;
	while (i > 1) {
		// Set the coalescence time
		rate = i * (i - 1) / 2.0;
		Ti = rexp(1/rate);
		if (f != 1.0) {
			// this part models expansion/bottleneck
			if (Ttot > Tb) {
				rate = f * i * (i - 1) / 2.0;
				Ti = rexp(1/rate) + Tb;
			}
		}
		/* rate is in unit 1/s; want unit s so invert */
		Ttot += Ti;
		nodes[j]->time = Ttot;

		// Make a number of mutations and sprinkle them out
		int n_mut, l;
		// Remember; we need to multiply rate also by the number of
		// branches; otherwise we're only generating a number of
		// mutations proportional to TMRCA, not TBL
		n_mut = (int) rpois((double) (theta / 2 * Ti * i));
		for (k=0; k<n_mut; k++) {
			l = (int) runif(0.0, (double) i);
			nodes[l]->mutations++;
		}

		// Note that the coalescent event can be performed after
		// setting the time and placing mutations as we know the id of
		// the parent beforehand
		coalesce(nodes, j, i);
		i--;
		j++;
	}

	PutRNGstate();
	for (k=0; k < n_nodes; k++) {
		if (isroot(nodes[k]))
			return nodes[k];
	}
}
Esempio n. 29
0
File: rand.c Progetto: nickbloom/MNP
/* Sample from a univariate truncated Normal distribution 
   (truncated both from above and below): choose either inverse cdf
   method or rejection sampling method. For rejection sampling, 
   if the range is too far from mu, it uses standard rejection
   sampling algorithm with exponential envelope function. */ 
double TruncNorm(
		 double lb,  /* lower bound */ 
		 double ub,  /* upper bound */
		 double mu,  /* mean */
		 double var, /* variance */
		 int invcdf  /* use inverse cdf method? */
		 ) {
  
  double z;
  double sigma = sqrt(var);
  double stlb = (lb-mu)/sigma;  /* standardized lower bound */
  double stub = (ub-mu)/sigma;  /* standardized upper bound */
  if(stlb > stub)
    error("TruncNorm: lower bound is greater than upper bound\n");
  if(stlb == stub) {
    warning("TruncNorm: lower bound is equal to upper bound\n");
    return(stlb*sigma + mu);
  }
  if (invcdf) {  /* inverse cdf method */
    z = qnorm(runif(pnorm(stlb, 0, 1, 1, 0), pnorm(stub, 0, 1, 1, 0)),
	      0, 1, 1, 0); 
  }
  else { /* rejection sampling method */
    double tol=2.0;
    double temp, M, u, exp_par;
    int flag=0;  /* 1 if stlb, stub <-tol */
    if(stub<=-tol){
      flag=1;
      temp=stub;
      stub=-stlb;
      stlb=-temp;
    }
    if(stlb>=tol){
      exp_par=stlb;
      while(pexp(stub,1/exp_par,1,0) - pexp(stlb,1/exp_par,1,0) < 0.000001) 
	exp_par/=2.0;
      if(dnorm(stlb,0,1,1) - dexp(stlb,1/exp_par,1) >=
	 dnorm(stub,0,1,1) - dexp(stub,1/exp_par,1)) 
	M=exp(dnorm(stlb,0,1,1) - dexp(stlb,1/exp_par,1));
      else
	M=exp(dnorm(stub,0,1,1) - dexp(stub,1/exp_par,1));
      do{ 
	u=unif_rand();
	z=-log(1-u*(pexp(stub,1/exp_par,1,0)-pexp(stlb,1/exp_par,1,0))
	       -pexp(stlb,1/exp_par,1,0))/exp_par;
      }while(unif_rand() > exp(dnorm(z,0,1,1)-dexp(z,1/exp_par,1))/M );  
      if(flag==1) z=-z;
    } 
    else{ 
      do z=norm_rand();
      while( z<stlb || z>stub ); 
    }
  }
  return(z*sigma + mu); 
}
Esempio n. 30
0
/* sample from truncated inverse chi squared truncated above at "max" */
double TruncInvChisq(int df, double scale, double max, int invcdf) {

  double temp = 0, temp_pg, g_shape, g_scale;
  double out;
  int i;

  g_shape = (double)df / 2;
  g_scale = 2 / ((double)df * scale);

  if (invcdf) {/* inverse cdf method */

    temp = runif(0, 1);
    temp_pg = pgamma(1 / max, g_shape, g_scale, 1, 0);

    temp = (temp * ((double)1 - temp_pg)) + temp_pg;

    out = qgamma(temp, g_shape, g_scale, 1, 0);

  } else {/* rejection sampling method */

    for (i = 0; i < 10000; i++) {
      out = rgamma(g_shape, g_scale);

      if (out > 1 / max ) break;
      
      if (temp == 9999) {
/* 	error("Too many rejections.  Try the inverse-CDF method"); */

	/* If there are too many rejections, inverse-CDF method */
	temp = runif(0, 1);
	temp_pg = pgamma(1 / max, g_shape, g_scale, 1, 0);

	temp = (temp * ((double)1 - temp_pg)) + temp_pg;

	out = qgamma(temp, g_shape, g_scale, 1, 0);

      }
    }
  }

  return (1 / out);
}