CR2RE Pipeline Reference Manual 1.6.7
igam.c
1/*
2igam.c from torch-cephes which is a BSD licensed redistribution of cephes [0]
3Minor modifications to use C99 lgamma and removed K&R syntax.
4
5[0] https://github.com/jucor/torch-cephes/blob/master/LICENSE.txt
6
7Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier
8
9All rights reserved.
10
11Redistribution and use in source and binary forms, with or without
12modification, are permitted provided that the following conditions are met:
13 * Redistributions of source code must retain the above copyright
14 notice, this list of conditions and the following disclaimer.
15 * Redistributions in binary form must reproduce the above copyright
16 notice, this list of conditions and the following disclaimer in the
17 documentation and/or other materials provided with the distribution.
18 * Neither the name of the organization nor the
19 names of its contributors may be used to endorse or promote products
20 derived from this software without specific prior written permission.
21
22THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
23ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
24WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
25DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
26DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
27(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
29ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
30(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32*/
33
34/*
35 * Incomplete gamma integral -> igam.c
36 *
37 *
38 *
39 * SYNOPSIS:
40 *
41 * double a, x, y, igam();
42 *
43 * y = igam( a, x );
44 *
45 * DESCRIPTION:
46 *
47 * The function is defined by
48 *
49 * x
50 * -
51 * 1 | | -t a-1
52 * igam(a,x) = ----- | e t dt.
53 * - | |
54 * | (a) -
55 * 0
56 *
57 *
58 * In this implementation both arguments must be positive.
59 * The integral is evaluated by either a power series or
60 * continued fraction expansion, depending on the relative
61 * values of a and x.
62 *
63 * ACCURACY:
64 *
65 * Relative error:
66 * arithmetic domain # trials peak rms
67 * IEEE 0,30 200000 3.6e-14 2.9e-15
68 * IEEE 0,100 300000 9.9e-14 1.5e-14
69 */
70
71/*
72 * Complemented incomplete gamma integral --> igamc()
73 *
74 *
75 *
76 * SYNOPSIS:
77 *
78 * double a, x, y, igamc();
79 *
80 * y = igamc( a, x );
81 *
82 * DESCRIPTION:
83 *
84 * The function is defined by
85 *
86 *
87 * igamc(a,x) = 1 - igam(a,x)
88 *
89 * inf.
90 * -
91 * 1 | | -t a-1
92 * = ----- | e t dt.
93 * - | |
94 * | (a) -
95 * x
96 *
97 *
98 * In this implementation both arguments must be positive.
99 * The integral is evaluated by either a power series or
100 * continued fraction expansion, depending on the relative
101 * values of a and x.
102 *
103 * ACCURACY:
104 *
105 * Tested at random a, x.
106 * a x Relative error:
107 * arithmetic domain domain # trials peak rms
108 * IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15
109 * IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15
110 */
111
112/*
113 * Cephes Math Library Release 2.8: June, 2000
114 * Copyright 1985, 1987, 2000 by Stephen L. Moshier
115 */
116
117#ifdef HAVE_CONFIG_H
118 #include <config.h>
119#endif
120
121#include <math.h>
122#include <float.h>
123
124double igam(double, double);
125double igamc(double, double);
126
127#define MACHEP DBL_EPSILON
128#define MAXLOG log(FLT_MAX)
129#define mtherr(x, y)
130
131static double big = 4.503599627370496e15;
132static double biginv = 2.22044604925031308085e-16;
133
134double igamc(double a, double x)
135{
136 double ans, ax, c, r, t, y, z;
137 double pkm1, pkm2, qkm1, qkm2;
138
139 if ((x < 0) || ( a <= 0)) {
140 mtherr("igamc", DOMAIN);
141 return(NAN);
142 }
143
144 if ((x < 1.0) || (x < a)) {
145 return(1. - igam(a,x));
146 }
147 ax = a * log(x) - x - lgamma(a);
148
149 if (ax < -MAXLOG) {
150 mtherr("igamc", UNDERFLOW);
151 return(0.);
152 }
153 ax = exp(ax);
154
155 /* continued fraction */
156 y = 1. - a;
157 z = x + y + 1.;
158 c = 0.;
159 pkm2 = 1.;
160 qkm2 = x;
161 pkm1 = x + 1.;
162 qkm1 = z * x;
163 ans = pkm1/qkm1;
164
165 do {
166 c += 1.;
167 y += 1.;
168 z += 2.;
169
170 double yc = y * c;
171 double pk = pkm1 * z - pkm2 * yc;
172 double qk = qkm1 * z - qkm2 * yc;
173
174 if (qk != 0) {
175 r = pk / qk;
176 t = fabs((ans - r) / r);
177 ans = r;
178 } else {
179 t = 1.;
180 }
181
182 pkm2 = pkm1;
183 pkm1 = pk;
184 qkm2 = qkm1;
185 qkm1 = qk;
186
187 if (fabs(pk) > big) {
188 pkm2 *= biginv;
189 pkm1 *= biginv;
190 qkm2 *= biginv;
191 qkm1 *= biginv;
192 }
193
194 } while(t > MACHEP);
195
196 return( ans * ax );
197}
198
199
200/* left tail of incomplete gamma function:
201*
202* inf. k
203* a -x - x
204* x e > ----------
205* - -
206* k=0 | (a+k+1)
207*
208*/
209
210double igam(double a, double x)
211{
212 double ans, ax, c, r;
213
214 /* Check zero integration limit first */
215 if (x == 0) {
216 return(0.);
217 }
218
219 if ((x < 0) || (a <= 0)) {
220 mtherr("igam", DOMAIN);
221 return(NAN);
222 }
223
224 if ((x > 1.) && (x > a)) {
225 return(1. - igamc(a,x));
226 }
227
228 /* Compute x**a * exp(-x) / gamma(a) */
229 ax = a * log(x) - x - lgamma(a);
230 if (ax < -MAXLOG) {
231 mtherr("igam", UNDERFLOW);
232 return(0.);
233 }
234 ax = exp(ax);
235
236 /* power series */
237 r = a;
238 c = 1.;
239 ans = 1.;
240
241 do {
242 r += 1.;
243 c *= x / r;
244 ans += c;
245
246 } while(c/ans > MACHEP);
247
248 return(ans * ax / a);
249}