malt-wr
yield.c
Go to the documentation of this file.
1 #include <math.h>
2 #include <stdio.h>
3 #include <stdlib.h>
4 
5 #define DEBUG 0
6 
7 
8 
9 #define FUNC(x) ((*func)(x))
10 
11 static double trapzd(double (*func)(double), double a, double b, int n)
12 {
13  double x,tnm,sum,del;
14  static double s;
15  static int it;
16  int j;
17 
18  if (n == 1) {
19  it=1;
20  return (s=0.5*(b-a)*(FUNC(a)+FUNC(b)));
21  } else {
22  tnm=it;
23  del=(b-a)/tnm;
24  x=a+0.5*del;
25  for (sum=0.0,j=1;j<=it;j++,x+=del) sum += FUNC(x);
26  it *= 2;
27  s=0.5*(s+(b-a)*sum/tnm);
28  return s;
29  }
30 }
31 
32 
33 #define EPS 1.0e-6
34 #define JMAX 20
35 
36 static double qsimp(double (*func)(double), double a, double b)
37 {
38  int j;
39  double s,st,ost,os;
40 
41  ost = os = -1.0e30;
42  for (j=1;j<=JMAX;j++) {
43  st=trapzd(func,a,b,j);
44  s=(4.0*st-ost)/3.0;
45  if (fabs(s-os) < EPS*fabs(os)) return s;
46  os=s;
47  ost=st;
48  }
49  nrerror("Too many steps in routine QSIMP");
50 }
51 
52 #undef EPS
53 #undef JMAX
54 
55 
56 double normal(double x)
57 {
58  double y;
59 
60  y=-x*x/2;
61  y=exp(y)/sqrt(2*M_PI);
62  return (double) y;
63 }
64 
65 
66 static dimensions;
67 
68 static double multinormal(double x)
69 {
70  int i;
71  double mx, y;
72 
73  y=-x*x/2;
74  mx=1.0;
75  for(i=0;i<dimensions-1; i++)
76  mx*=x;
77  y=mx*exp(y);
78 
79  return y;
80 }
81 
82 
83 static int factorial(int n)
84 {
85  if(n<=1)
86  return 1;
87  else
88  return n*factorial(n-1);
89 }
90 
91 static int double_factorial(int n)
92 {
93  if(n<=1)
94  return 1;
95  else
96  return n*factorial(n-2);
97 }
98 
99 static long int power2(int n)
100 {
101  long int ny=1;
102 
103  while(n--)
104  ny*=2;
105 
106  return ny;
107 }
108 
109 static double multicoeff(int n)
110 {
111  int s, odd;
112 
113  s=(n-1)/2;
114  odd=(n-1)%2;
115 
116  if(odd)
117  return 1.0/(power2(s)*factorial(s));
118  else
119  return sqrt(2/M_PI)/double_factorial(2*s-1);
120 }
121 
122 
123 double area(double leftmargin, double rightmargin)
124 {
125  return qsimp(normal, 0, leftmargin) + qsimp(normal, 0, rightmargin);
126 }
127 
128 
129 double multiarea(double r, int dim)
130 {
131  double coeff, integral;
132 
133  dimensions = dim;
134  integral=qsimp(multinormal, 0, r);
135  coeff = multicoeff(dim);
136 
137  return integral*coeff;
138 }
139 
140 
141 
142 
143 #define IM 714025
144 #define IA 4096
145 #define IC 54773
146 
147 #define SHUFFLE_LENGTH 98
148 
149 
150 double uniform_deviate(long *idum)
151 /*
152  Return a uniform random deviate between 0.0 and 1.0.
153  Set idum to any negative value to initialize or reinitialize the
154  sequance.
155 */
156 {
157 
158  static long iy, shuff_tab[SHUFFLE_LENGTH];
159  static int iff=0;
160 
161  int j;
162 
163  if((*idum < 0) || (iff==0)) {
164  iff = 1;
165  if((*idum = (IC-(*idum)) % IM) < 0)
166  *idum = - (*idum);
167 
168  /* initialize the shuffle table */
169  for(j=1; j<=SHUFFLE_LENGTH-1; j++) {
170  *idum = (IA*(unsigned long)(*idum)+IC) % IM;
171  shuff_tab[j] = (*idum);
172  }
173  *idum = (IA*(unsigned long)(*idum)+IC) % IM;
174  iy = (*idum);
175  }
176  j = 1 + (SHUFFLE_LENGTH-1)*iy/IM;
177 
178  if((j>SHUFFLE_LENGTH-1) || (j<0))
179  nrerror("Error in random number generator uniform_deviate.");
180 
181  iy = shuff_tab[j];
182 
183  *idum = (IA*(unsigned long)(*idum)+IC) % IM;
184  shuff_tab[j] = *idum;
185 
186  return (double) iy/ IM;
187 }
188 
189 
190 static double gauss_deviate(long *idum)
191 /*
192  rightReturns a normally distributed deviate with zero mean and unit variance,
193  using uniform_deviate() as the source of uniform deviates.
194 */
195 {
196  static int iset=0;
197  static double gset;
198 
199  double fac, r, v1, v2;
200 
201  if(iset == 0) {
202  do {
203  /* pick two uniform numbers in the square extending
204  from -1.0 to +1.0 in each direction */
205  v1 = 2.0*uniform_deviate(idum) - 1.0;
206  v2 = 2.0*uniform_deviate(idum) - 1.0;
207  r = v1*v1 + v2*v2;
208  } while(r>=1.0);
209 
210  /* Now make the Box-Muller transformation to get two
211  normal deviates. Return one and save the other for
212  next time */
213  fac = sqrt(-2.0*log(r)/r);
214 
215  gset = v1*fac;
216  iset = 1;
217  return v2*fac;
218  }
219  else {
220  iset = 0;
221  return gset;
222  }
223 
224 }
225 
226 #if DEBUG
227 main()
228 {
229 double lm, rm;
230 
231 printf("left margin=");
232 scanf("%lf", &lm);
233 printf("right margin=");
234 scanf("%lf", &rm);
235 printf("... %6.4f %6.4f\n",lm,rm);
236 printf("the answer is ... %6.4f\n",area(lm,rm));
237 }
238 #endif
#define SHUFFLE_LENGTH
Definition: yield.c:147
static double multinormal(double x)
Definition: yield.c:68
#define JMAX
Definition: yield.c:34
#define FUNC(x)
Definition: yield.c:9
static dimensions
Definition: yield.c:66
static double multicoeff(int n)
Definition: yield.c:109
int dim
Definition: points.c:11
#define IM
Definition: yield.c:143
#define IC
Definition: yield.c:145
void nrerror(char *error_text)
Definition: lineread.c:7
static int factorial(int n)
Definition: yield.c:83
#define IA
Definition: yield.c:144
static int double_factorial(int n)
Definition: yield.c:91
static double trapzd(double(*func)(double), double a, double b, int n)
Definition: yield.c:11
int main(int argc, char **argv)
Definition: maininit.c:199
double multiarea(double r, int dim)
Definition: yield.c:129
static long int power2(int n)
Definition: yield.c:99
static double qsimp(double(*func)(double), double a, double b)
Definition: yield.c:36
double area(double leftmargin, double rightmargin)
Definition: yield.c:123
#define EPS
Definition: yield.c:33
double uniform_deviate(long *idum)
Definition: yield.c:150
static double gauss_deviate(long *idum)
Definition: yield.c:190
double normal(double x)
Definition: yield.c:56