TMB Documentation  v1.9.11
stirlerr.cpp
1 /*
2  * AUTHOR
3  * Catherine Loader, catherine@research.bell-labs.com.
4  * October 23, 2000.
5  *
6  * Merge in to R:
7  * Copyright (C) 2000, The R Core Team
8  *
9  * This program is free software; you can redistribute it and/or modify
10  * it under the terms of the GNU General Public License as published by
11  * the Free Software Foundation; either version 2 of the License, or
12  * (at your option) any later version.
13  *
14  * This program is distributed in the hope that it will be useful,
15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17  * GNU General Public License for more details.
18  *
19  * You should have received a copy of the GNU General Public License
20  * along with this program; if not, a copy is available at
21  * https://www.R-project.org/Licenses/
22  *
23  *
24  * DESCRIPTION
25  *
26  * Computes the log of the error term in Stirling's formula.
27  * For n > 15, uses the series 1/12n - 1/360n^3 + ...
28  * For n <=15, integers or half-integers, uses stored values.
29  * For other n < 15, uses lgamma directly (don't use this to
30  * write lgamma!)
31  *
32  * Merge in to R:
33  * Copyright (C) 2000, The R Core Team
34  * R has lgammafn, and lgamma is not part of ISO C
35  */
36 
37 
38 /* stirlerr(n) = log(n!) - log( sqrt(2*pi*n)*(n/e)^n )
39  * = log Gamma(n+1) - 1/2 * [log(2*pi) + log(n)] - n*[log(n) - 1]
40  * = log Gamma(n+1) - (n + 1/2) * log(n) + n - log(2*pi)/2
41  *
42  * see also lgammacor() in ./lgammacor.c which computes almost the same!
43  */
44 
45 template<class Float>
46 Float attribute_hidden stirlerr(Float n)
47 {
48 
49 #define S0 0.083333333333333333333 /* 1/12 */
50 #define S1 0.00277777777777777777778 /* 1/360 */
51 #define S2 0.00079365079365079365079365 /* 1/1260 */
52 #define S3 0.000595238095238095238095238 /* 1/1680 */
53 #define S4 0.0008417508417508417508417508/* 1/1188 */
54 
55 /*
56  error for 0, 0.5, 1.0, 1.5, ..., 14.5, 15.0.
57 */
58  const static double sferr_halves[31] = {
59  0.0, /* n=0 - wrong, place holder only */
60  0.1534264097200273452913848, /* 0.5 */
61  0.0810614667953272582196702, /* 1.0 */
62  0.0548141210519176538961390, /* 1.5 */
63  0.0413406959554092940938221, /* 2.0 */
64  0.03316287351993628748511048, /* 2.5 */
65  0.02767792568499833914878929, /* 3.0 */
66  0.02374616365629749597132920, /* 3.5 */
67  0.02079067210376509311152277, /* 4.0 */
68  0.01848845053267318523077934, /* 4.5 */
69  0.01664469118982119216319487, /* 5.0 */
70  0.01513497322191737887351255, /* 5.5 */
71  0.01387612882307074799874573, /* 6.0 */
72  0.01281046524292022692424986, /* 6.5 */
73  0.01189670994589177009505572, /* 7.0 */
74  0.01110455975820691732662991, /* 7.5 */
75  0.010411265261972096497478567, /* 8.0 */
76  0.009799416126158803298389475, /* 8.5 */
77  0.009255462182712732917728637, /* 9.0 */
78  0.008768700134139385462952823, /* 9.5 */
79  0.008330563433362871256469318, /* 10.0 */
80  0.007934114564314020547248100, /* 10.5 */
81  0.007573675487951840794972024, /* 11.0 */
82  0.007244554301320383179543912, /* 11.5 */
83  0.006942840107209529865664152, /* 12.0 */
84  0.006665247032707682442354394, /* 12.5 */
85  0.006408994188004207068439631, /* 13.0 */
86  0.006171712263039457647532867, /* 13.5 */
87  0.005951370112758847735624416, /* 14.0 */
88  0.005746216513010115682023589, /* 14.5 */
89  0.005554733551962801371038690 /* 15.0 */
90  };
91  Float nn;
92 
93  if (n <= 15.0) {
94  nn = n + n;
95  if (nn == (int)trunc(nn)) return(sferr_halves[(int)trunc(nn)]);
96  return(lgammafn(n + 1.) - (n + 0.5)*log(n) + n - M_LN_SQRT_2PI);
97  }
98 
99  nn = n*n;
100  if (n>500) return((S0-S1/nn)/n);
101  if (n> 80) return((S0-(S1-S2/nn)/nn)/n);
102  if (n> 35) return((S0-(S1-(S2-S3/nn)/nn)/nn)/n);
103  /* 15 < n <= 35 : */
104  return((S0-(S1-(S2-(S3-S4/nn)/nn)/nn)/nn)/n);
105 }
License: GPL v2