sp_random.cpp
Go to the documentation of this file.
1 /** @file sp_random.cpp Evaluating random variables */
2 
3 /*
4  FAU Discrete Event System Simulator
5 
6  Copyright (C) 2007 Christoph Doerr
7  Exclusive copyright is granted to Thomas Moor
8 */
9 
10 #include "sp_random.h"
11 
12 #include <cmath>
13 
14 
15 
16 
17 namespace faudes {
18 
19 
20 
21 #define MODULUS 2147483647 /* DON'T CHANGE THIS VALUE */
22 #define MULTIPLIER 48271 /* DON'T CHANGE THIS VALUE */
23 #define CHECK 399268537 /* DON'T CHANGE THIS VALUE */
24 #define STREAMS 256 /* # of streams, DON'T CHANGE THIS VALUE */
25 #define A256 22925 /* jump multiplier, DON'T CHANGE THIS VALUE */
26 #define DEFAULT 123456789 /* initial seed, use 0 < DEFAULT < MODULUS */
27 
28 static long ran_seed[STREAMS] = {DEFAULT}; /* current state of each stream */
29 static int ran_stream = 0; /* stream index, 0 is the default */
30 static int ran_initialized = 0; /* test for stream initialization */
31 
32 
33 //ran_plant_seeds(x)
34 void ran_plant_seeds(long x)
35 {
36  const long Q = MODULUS / A256;
37  //calculate inverse CDF (algorithm based on a rational approximation algorithm by Peter J. Acklam)
38  const long R = MODULUS % A256;
39  int j;
40  int s;
41 
42  ran_initialized = 1;
43  s = ran_stream; /* remember the current stream */
44  ran_select_stream(0); /* change to stream 0 */
45  ran_put_seed(x); /* set seed[0] */
46  ran_stream = s; /* reset the current stream */
47  for (j = 1; j < STREAMS; j++) {
48  x = A256 * (ran_seed[j - 1] % Q) - R * (ran_seed[j - 1] / Q);
49  if (x > 0)
50  ran_seed[j] = x;
51  else
52  ran_seed[j] = x + MODULUS;
53  }
54 }
55 
56 //ran_put_seed(x)
57 void ran_put_seed(long seed)
58 {
59  ran_seed[ran_stream] = seed;
60 }
61 
62 //ran_select_stream(index)
63 void ran_select_stream(int index)
64 {
65  ran_stream = ((unsigned int) index) % STREAMS;
66  if ((ran_initialized == 0) && (ran_stream != 0)) /* protect against */
67  ran_plant_seeds(DEFAULT); /* un-initialized streams */
68 }
69 
70 //an_init(seed)
71 void ran_init(long seed){
72  ran_select_stream(0); /* select the default stream */
73  ran_put_seed(seed);
74 }
75 
76 
77 // ran()
78 double ran(void){
79  const long Q = MODULUS / MULTIPLIER;
80  const long R = MODULUS % MULTIPLIER;
81  long t;
82 
83  t = MULTIPLIER * (ran_seed[ran_stream] % Q) - R * (ran_seed[ran_stream] / Q);
84  if (t > 0)
85  ran_seed[ran_stream] = t;
86  else
88  return ((double) ran_seed[ran_stream] / MODULUS);
89 
90 }
91 
92 
93 // ran_uniform(a,b)
94 double ran_uniform(double a, double b){
95  double q = ran();
96  q=a*(1-q)+b*q;
97  return q;
98 }
99 
100 // ran_uniform(a,b)
101 long ran_uniform_int(long a, long b){
102  double q = ran();
103  long i =(long) floor(((double) a)*(1-q)+((double)b)*q);
104  if(i>=b) i=b-1;
105  if(i< a) i=a;
106  return i;
107 }
108 
109 // ran_exponential(mu)
110 double ran_exponential(double mu){
111  double q=0;
112  while(q==0){
113  q=ran();
114  }
115  return -mu*log(q);
116 }
117 
118 // ran_expontial(mu, tossLB, tossUB)
119 double ran_exponential(double mu, tpTime::Type tossLB, tpTime::Type tossUB){
120  if(tossLB==tossUB){
121  FD_DS("Ran_exponential(): empty interval");
122  return tpTime::UnDef;
123  }
124  else{
125  double lb= -expm1(-(static_cast<double> (tossLB))/ mu);
126  double ub= -expm1(-(static_cast<double> (tossUB))/ mu);
127  double u=ran_uniform(lb,ub);
128  double ret=(-mu*(log(1-u)));
129  //FD_DS("Ran_exponential: lb="<<lb<<" ub="<<ub<<" u="<<u<<" ret="<<ret);
130  return ret;
131  }
132 }
133 
134 /* ran_gauss(mu, sigma, tossLB, tossUB) */
135 double ran_gauss(double mu, double sigma, tpTime::Type tossLB, tpTime::Type tossUB){
136  if(tossLB==tossUB){
137  FD_DS("Ran_gauss(): empty interval");
138  return tpTime::UnDef;
139  }
140  else{
141  //Transform to (0,1)-Normaldistribution
142  double ztossLB=(static_cast<double>(tossLB)-mu)/sigma;
143  double ztossUB=(static_cast<double>(tossUB)-mu)/sigma;
144  //Sample Boundaries
145  double zlb=ran_gaussian_cdf_P(ztossLB);
146  double zub=ran_gaussian_cdf_P(ztossUB);
147  double u=ran_uniform(zlb,zub);
148 
149  //FD_DS("Ran_gauss(): ztossLB="<<ztossLB<<" ztossUB="<<ztossUB << " zlb="<<zlb<<" zub="<<zub<<" -> u="<<u);
150 
151  //calculate inverse CDF (algorithm based on a rational approximation algorithm by Peter J. Acklam)
152  double zret;
153  static const double a[] =
154  {
155  -3.969683028665376e+01,
156  2.209460984245205e+02,
157  -2.759285104469687e+02,
158  1.383577518672690e+02,
159  -3.066479806614716e+01,
160  2.506628277459239e+00
161  };
162 
163  static const double b[] =
164  {
165  -5.447609879822406e+01,
166  1.615858368580409e+02,
167  -1.556989798598866e+02,
168  6.680131188771972e+01,
169  -1.328068155288572e+01
170  };
171 
172  static const double c[] =
173  {
174  -7.784894002430293e-03,
175  -3.223964580411365e-01,
176  -2.400758277161838e+00,
177  -2.549732539343734e+00,
178  4.374664141464968e+00,
179  2.938163982698783e+00
180  };
181 
182  static const double d[] =
183  {
184  7.784695709041462e-03,
185  3.224671290700398e-01,
186  2.445134137142996e+00,
187  3.754408661907416e+00
188  };
189  double q,r;
190  if(u<0 || u>1) zret=0.0;
191  else if (u==0){
192  FD_DS("Ran_gauss(): u="<<u<<"ret=HUGE_VAL");
193  return -HUGE_VAL;
194  }
195  else if (u==1){
196  FD_DS("Ran_gauss(): u="<<u<<"ret=-HUGE_VAL");
197  return HUGE_VAL;
198  }
199  else if (u<0.02425){
200  // Rational approximation for lower region
201  q = sqrt(-2*log(u));
202  zret=(((((c[0]*q+c[1])*q+c[2])*q+c[3])*q+c[4])*q+c[5]) /
203  ((((d[0]*q+d[1])*q+d[2])*q+d[3])*q+1);
204  }
205  else if(u>0.97575){
206  // Rational approximation for upper region
207  q = sqrt(-2*log(1-u));
208  zret= -(((((c[0]*q+c[1])*q+c[2])*q+c[3])*q+c[4])*q+c[5]) /
209  ((((d[0]*q+d[1])*q+d[2])*q+d[3])*q+1);
210  }
211  else{
212  // Rational approximation for central region
213  q = u - 0.5;
214  r = q*q;
215  zret=(((((a[0]*r+a[1])*r+a[2])*r+a[3])*r+a[4])*r+a[5])*q /
216  (((((b[0]*r+b[1])*r+b[2])*r+b[3])*r+b[4])*r+1);
217  }
218  //Transform to (mu,sigma)-Distribution
219  double ret=(zret*sigma)+mu; //to_do: overflow protection
220  //FD_DS("Ran_gauss(): zret="<<zret<<" ret="<<ret);
221  return ret;
222  }
223 }
224 
225 
226 //ran_gaussian_cdf_P
227 double ran_gaussian_cdf_P(double x){
228  const double PI = 3.141592654;
229  const double b1 = 0.319381530;
230  const double b2 = -0.356563782;
231  const double b3 = 1.781477937;
232  const double b4 = -1.821255978;
233  const double b5 = 1.330274429;
234  const double p = 0.2316419;
235 
236  if(x >= 0.0) {
237  double t = 1.0 / (1.0 + p*x);
238  return (1.0 - (1/sqrt(2*PI))*exp(-x*x/2.0 )*t*
239  (t*(t*(t*(t*b5 + b4) + b3) + b2) + b1));
240  }
241  else {
242  double t = 1.0 / ( 1.0 - p * x );
243  return ( (1/sqrt(2*PI))*exp(-x*x/2.0 )*t*
244  (t*(t*(t*(t*b5 + b4) + b3) + b2) + b1));
245  }
246 
247 
248 }
249 
250 
251 } // name space

libFAUDES 2.24g --- 2014.09.15 --- c++ api documentaion by doxygen