Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This include file contains the implementation of procedures in [pm_distGenGamma](@ref pm_distGenGamma).
19 : !>
20 : !> \author
21 : !> \AmirShahmoradi, Oct 16, 2009, 12:20 PM, Michigan
22 :
23 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 : #if getGenGammaLogPDFNF_ENABLED && KDD_ENABLED
27 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
28 :
29 32735 : CHECK_ASSERTION(__LINE__, kappa > 0._RKC, SK_"@getGenGammaLogPDFNF(): The condition `kappa > 0.` must hold. kappa = "//getStr(kappa)) ! fpp
30 32735 : logPDFNF = -log_gamma(kappa)
31 :
32 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
33 : #elif getGenGammaLogPDFNF_ENABLED && KOD_ENABLED
34 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
35 :
36 31696 : CHECK_ASSERTION(__LINE__, invOmega > 0._RKC, SK_"@getGenGammaLogPDFNF(): The condition `invOmega > 0.` must hold. invOmega = "//getStr(invOmega)) ! fpp
37 31696 : logPDFNF = getGenGammaLogPDFNF(kappa)
38 31696 : if (invOmega /= 1._RKC) logPDFNF = logPDFNF + log(invOmega)
39 :
40 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
41 : #elif getGenGammaLogPDFNF_ENABLED && KOS_ENABLED
42 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
43 :
44 31677 : CHECK_ASSERTION(__LINE__, invSigma > 0._RKC, SK_"@getGenGammaLogPDFNF(): The condition `invSigma > 0.` must hold. invSigma = "//getStr(invSigma)) ! fpp
45 31677 : logPDFNF = getGenGammaLogPDFNF(kappa, invOmega)
46 31677 : if (invSigma /= 1._RKC) logPDFNF = logPDFNF + log(invSigma)
47 :
48 : !%%%%%%%%%%%%%%%%%%%%%%%%
49 : #elif getGenGammaLogPDF_ENABLED
50 : !%%%%%%%%%%%%%%%%%%%%%%%%
51 :
52 : real(RKC) :: kappa_def, invOmega_def, invSigma_def
53 6554 : kappa_def = 1._RKC; if (present(kappa)) kappa_def = kappa
54 6554 : invOmega_def = 1._RKC; if (present(invOmega)) invOmega_def = invOmega
55 6554 : invSigma_def = 1._RKC; if (present(invSigma)) invSigma_def = invSigma
56 6554 : call setGenGammaLogPDF(logPDF, x, getGenGammaLogPDFNF(kappa_def, invOmega_def, invSigma_def), kappa_def, invOmega_def, invSigma_def)
57 :
58 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
59 : #elif setGenGammaLogPDF_ENABLED && DDDD_ENABLED
60 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
61 :
62 1 : CHECK_ASSERTION(__LINE__, x > 0._RKC, SK_"@getGenGammaLogPDFNF(): The condition `x > 0.` must hold. x = "//getStr(x)) ! fpp
63 1 : logPDF = -x
64 :
65 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
66 : #elif setGenGammaLogPDF_ENABLED && NKDD_ENABLED
67 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
68 :
69 11 : CHECK_ASSERTION(__LINE__, x > 0._RKC, SK_"@getGenGammaLogPDFNF(): The condition `x > 0.` must hold. x = "//getStr(x)) ! fpp
70 11 : CHECK_ASSERTION(__LINE__, kappa > 0._RKC, SK_"@getGenGammaLogPDFNF(): The condition `kappa > 0.` must hold. kappa = "//getStr(kappa)) ! fpp
71 33 : CHECK_ASSERTION(__LINE__, abs(getGenGammaLogPDFNF(kappa) - logPDFNF) <= 100 * epsilon(0._RKC), \
72 : SK_"@setGenGammaLogPDF(): The condition `abs(getGenGammaLogPDFNF(kappa) - logPDFNF) <= 100 * epsilon(0._RKC)` must hold. getGenGammaLogPDFNF(kappa), logPDFNF = " \
73 : //getStr([getGenGammaLogPDFNF(kappa), logPDFNF])) ! fpp
74 11 : logPDF = logPDFNF + log(x) * (kappa - 1._RKC) - x
75 :
76 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
77 : #elif setGenGammaLogPDF_ENABLED && NKOD_ENABLED
78 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
79 :
80 1 : CHECK_ASSERTION(__LINE__, x > 0._RKC, SK_"@getGenGammaLogPDFNF(): The condition `x > 0.` must hold. x = "//getStr(x)) ! fpp
81 1 : CHECK_ASSERTION(__LINE__, kappa > 0._RKC, SK_"@getGenGammaLogPDFNF(): The condition `kappa > 0.` must hold. kappa = "//getStr(kappa)) ! fpp
82 1 : CHECK_ASSERTION(__LINE__, invOmega > 0._RKC, SK_"@setGenGammaLogPDF(): The condition `invOmega > 0.` must hold. invOmega = "//getStr(invOmega)) ! fpp
83 3 : CHECK_ASSERTION(__LINE__, abs(getGenGammaLogPDFNF(kappa, invOmega) - logPDFNF) <= 100 * epsilon(0._RKC), \
84 : SK_"@setGenGammaLogPDF(): The condition `abs(getGenGammaLogPDFNF(kappa, invOmega) - logPDFNF) <= 100 * epsilon(0._RKC)` must hold. getGenGammaLogPDFNF(kappa, invOmega), logPDFNF = " \
85 : //getStr([getGenGammaLogPDFNF(kappa, invOmega), logPDFNF])) ! fpp
86 1 : logPDF = logPDFNF + log(x) * (kappa * invOmega - 1._RKC) - x**invOmega
87 :
88 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
89 : #elif setGenGammaLogPDF_ENABLED && NKOS_ENABLED
90 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
91 :
92 : real(RKC) :: y
93 12555 : y = x * invSigma
94 12555 : CHECK_ASSERTION(__LINE__, x > 0._RKC, SK_"@getGenGammaLogPDFNF(): The condition `x > 0.` must hold. x = "//getStr(x)) ! fpp
95 12555 : CHECK_ASSERTION(__LINE__, kappa > 0._RKC, SK_"@getGenGammaLogPDFNF(): The condition `kappa > 0.` must hold. kappa = "//getStr(kappa)) ! fpp
96 12555 : CHECK_ASSERTION(__LINE__, invOmega > 0._RKC, SK_"@setGenGammaLogPDF(): The condition `invOmega > 0.` must hold. invOmega = "//getStr(invOmega)) ! fpp
97 12555 : CHECK_ASSERTION(__LINE__, invSigma > 0._RKC, SK_"@setGenGammaLogPDF(): The condition `invSigma > 0.` must hold. invSigma = "//getStr(invSigma)) ! fpp
98 37665 : CHECK_ASSERTION(__LINE__, abs(getGenGammaLogPDFNF(kappa, invOmega, invSigma) - logPDFNF) <= 100 * epsilon(0._RKC), \
99 : SK_"@setGenGammaLogPDF(): The condition `abs(getGenGammaLogPDFNF(kappa, invOmega, invSigma) - logPDFNF) <= 100 * epsilon(0._RKC)` must hold. getGenGammaLogPDFNF(kappa, invOmega, invSigma), logPDFNF = " \
100 : //getStr([getGenGammaLogPDFNF(kappa, invOmega, invSigma), logPDFNF])) ! fpp
101 12555 : logPDF = logPDFNF + log(y) * (kappa * invOmega - 1._RKC) - y**invOmega
102 :
103 : !%%%%%%%%%%%%%%%%%%%%%
104 : #elif getGenGammaCDF_ENABLED
105 : !%%%%%%%%%%%%%%%%%%%%%
106 :
107 : integer(IK) :: info
108 : real(RKC) :: xnormed
109 6014 : if (present(invSigma)) then
110 6001 : xnormed = x * invSigma
111 : else
112 13 : xnormed = x
113 : end if
114 6014 : if (present(invSigma)) xnormed = xnormed ** invOmega
115 6014 : if (present(kappa)) then
116 6013 : call setGenGammaCDF(cdf, xnormed, log_gamma(kappa), kappa, info)
117 : else
118 1 : call setGenGammaCDF(cdf, xnormed, info)
119 : end if
120 6014 : if (info < 0_IK) error stop MODULE_NAME//SK_"@getGenGammaCDF(): The computation of the regularized Lower Incomplete Gamma function failed. This can happen if `kappa` is too large."
121 :
122 : !%%%%%%%%%%%%%%%%%%%%%
123 : #elif setGenGammaCDF_ENABLED
124 : !%%%%%%%%%%%%%%%%%%%%%
125 :
126 : #if DDD_ENABLED
127 : real(RKC), parameter :: kappa = 1._RKC, logGammaKappa = log_gamma(kappa)
128 2 : CHECK_ASSERTION(__LINE__, x > 0._RKC, SK_"@setGenGammaCDF(): The condition `x > 0.` must hold. x = "//getStr(x)) ! fpp
129 2 : call setGammaIncLow(cdf, x, logGammaKappa, kappa, info)
130 : #else
131 12026 : CHECK_ASSERTION(__LINE__, x > 0._RKC, SK_"@setGenGammaCDF(): The condition `x > 0.` must hold. x = "//getStr(x)) ! fpp
132 12026 : CHECK_ASSERTION(__LINE__, kappa > 0._RKC, SK_"@setGenGammaCDF(): The condition `kappa > 0.` must hold. kappa = "//getStr(kappa)) ! fpp
133 36078 : CHECK_ASSERTION(__LINE__, abs(log_gamma(kappa) - logGammaKappa) < 100 * epsilon(0._RKC), SK_"@setGenGammaCDF(): The condition `abs(log_gamma(kappa) - logGammaKappa) < 100 * epsilon(0._RKC)` must hold. log_gamma(kappa), logGammaKappa = "//getStr([log_gamma(kappa), logGammaKappa])) ! fpp
134 : #if KDD_ENABLED
135 6024 : call setGammaIncLow(cdf, x, logGammaKappa, kappa, info)
136 : #else
137 6002 : CHECK_ASSERTION(__LINE__, invOmega > 0._RKC, SK_"@setGenGammaCDF(): The condition `invOmega > 0.` must hold. invOmega = "//getStr(invOmega)) ! fpp
138 : #if KOD_ENABLED
139 1 : call setGammaIncLow(cdf, x**invOmega, logGammaKappa, kappa, info)
140 : #elif KOS_ENABLED
141 6001 : CHECK_ASSERTION(__LINE__, invSigma > 0._RKC, SK_"@setGenGammaCDF(): The condition `invSigma > 0.` must hold. invSigma = "//getStr(invSigma)) ! fpp
142 6001 : call setGammaIncLow(cdf, (x * invSigma)**invOmega, logGammaKappa, kappa, info)
143 : #else
144 : #error "Unrecognized interface."
145 : #endif
146 : #endif
147 : #endif
148 :
149 : #else
150 : !%%%%%%%%%%%%%%%%%%%%%%%%
151 : #error "Unrecognized interface."
152 : !%%%%%%%%%%%%%%%%%%%%%%%%
153 : #endif
|
