//======================================================================
// rnorm_trunc( mu, sigma, lower, upper)
//
// generates one random normal RVs with mean 'mu' and standard
// deviation 'sigma', truncated to the interval (lower,upper), where
// lower can be -Inf and upper can be Inf.
//======================================================================
double 
rnorm_trunc (double mu, double sigma, double lower, double upper)
{
 int	change;
 double	a, b;
 double	logt1 = log(0.150), logt2 = log(2.18), t3 = 0.725, t4 = 0.45;
 double	z, tmp, lograt;

 change = 0;
 a = (lower - mu)/sigma;
 b = (upper - mu)/sigma;
 
 // First scenario
 if( (a == R_NegInf) || (b == R_PosInf))
   {
     if(a == R_NegInf)
       {
	 change = 1;
	 a = -b;
	 b = R_PosInf;
       }
     
     // The two possibilities for this scenario
     if(a <= 0.45) z = norm_rs(a, b);
     else z = exp_rs(a, b);
     if(change) z = -z;
   }
 // Second scenario
 else if((a * b) <= 0.0)
   {
     // The two possibilities for this scenario
     if((dnorm(a, 0.0, 1.0, 1) <= logt1) || (dnorm(b, 0.0, 1.0, 1) <= logt1))
       {
	 z = norm_rs(a, b);
       }
     else z = unif_rs(a,b);
   }
 // Third scenario
 else
   {
     if(b < 0)
       {
	 tmp = b; b = -a; a = -tmp; change = 1;
       }
     
     lograt = dnorm(a, 0.0, 1.0, 1) - dnorm(b, 0.0, 1.0, 1);
     if(lograt <= logt2) z = unif_rs(a,b);
     else if((lograt > logt1) && (a < t3)) z = half_norm_rs(a,b);
     else z = exp_rs(a,b);
     if(change) z = -z;
   }
 
 return (sigma*z + mu);
}
void
rnorm_truncated (double *sample,  int *n, double *mu,
		 double *sigma, double *lower, double *upper)
{
 int		k;
 int		change;
 double	a, b;
 double	logt1 = log(0.150), logt2 = log(2.18), t3 = 0.725, t4 = 0.45;
 double	z, tmp, lograt;

 GetRNGstate();

 for (k=0; k<(*n); k++)
 {
   change = 0;
   a = (lower[k] - mu[k])/sigma[k];
   b = (upper[k] - mu[k])/sigma[k];

    // First scenario
    if( (a == R_NegInf) || (b == R_PosInf))
    {
       if(a == R_NegInf)
	{
          change = 1;
	   a = -b;
	   b = R_PosInf;
	}

	// The two possibilities for this scenario
       if(a <= 0.45) z = norm_rs(a, b);
	else z = exp_rs(a, b);
	if(change) z = -z;
    }
    // Second scenario
    else if((a * b) <= 0.0)
    {
       // The two possibilities for this scenario
       if((dnorm(a, 0.0, 1.0, 1) <= logt1) || (dnorm(b, 0.0, 1.0, 1) <= logt1))
	{
          z = norm_rs(a, b);
	}
	else z = unif_rs(a,b);
    }
    // Third scenario
    else
    {
       if(b < 0)
	{
	   tmp = b; b = -a; a = -tmp; change = 1;
	}

	lograt = dnorm(a, 0.0, 1.0, 1) - dnorm(b, 0.0, 1.0, 1);
	if(lograt <= logt2) z = unif_rs(a,b);
	else if((lograt > logt1) && (a < t3)) z = half_norm_rs(a,b);
	else z = exp_rs(a,b);
	if(change) z = -z;
    }

    sample[k] = sigma[k]*z + mu[k];
 }

 PutRNGstate();
}
Beispiel #3
0
void rnorm_truncated (double *sample,  int *n, double *mu, 
				  double *sigma, double *lower, double *upper)
{
  int		k;
  int		change = 0;
  double	a, b;
  double	logt1 = log(0.150), logt2 = log(2.18), t3 = 0.725, t4 = 0.45;
  double	z, tmp, lograt;

  a = (*lower - *mu)/(*sigma);
  b = (*upper - *mu)/(*sigma);

  if(a==b) Rprintf("Warning!! a=%f, b=%f\n",a,b);
  if(a>b) Rprintf("Warning!! a = %f > b = %f\n",a,b);
  
  for (k=0; k<(*n); k++)
  {
     change=0;
     // First scenario
     if( (a == R_NegInf) || (b == R_PosInf))
     {
        if(a == R_NegInf)
	{
           change = 1;
	   a = -b;
	   b = R_PosInf;
	}

	// The two possibilities for this scenario
     if(a <= t4) z = norm_rs(a, b);
	else z = exp_rs(a, b);
	if(change) z = -z;
     }
     // Second scenario
     else if((a * b) <= 0.0)
     {
        // The two possibilities for this scenario
        if((dnorm(a, 0.0, 1.0, 1) <= logt1) || (dnorm(b, 0.0, 1.0, 1) <= logt1))
	   {
           z = norm_rs(a, b);
	   }
	   else z = unif_rs(a,b);
     }
     // Third scenario
     else
     {
        if(b < 0)
	{
	   tmp = b; b = -a; a = -tmp; change = 1;
	}

	lograt = dnorm(a, 0.0, 1.0, 1) - dnorm(b, 0.0, 1.0, 1);
	if(lograt <= logt2) z = unif_rs(a,b);
	else if((lograt > logt1) && (a < t3)) z = half_norm_rs(a,b);
	else z = exp_rs(a,b);
	if(change) z = -z;
     }

     sample[k] = *sigma*z + *mu;
  }
}