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 procedure implementations of the tests of [pm_distBern](@ref pm_distBern).
19 : !>
20 : !> \fintest
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, Tuesday 2:06 AM, September 21, 2021, Dallas, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : !%%%%%%%%%%%%%
28 : #if isHead_ENABLED
29 : !%%%%%%%%%%%%%
30 :
31 : integer(IK) :: i
32 : integer(IK) , parameter :: NSIM = 20000_IK
33 : logical(LK) :: rand(NSIM)
34 :
35 : assertion = .true._LK
36 :
37 80004 : do i = 1_IK, NSIM
38 80004 : rand(i) = isHead()
39 : end do
40 80004 : assertion = assertion .and. logical(abs(NSIM / 2_IK - count(rand, kind = IK)) <= 5 * sqrt(real(NSIM / 2_IK)), LK)
41 4 : call test%assert(assertion, SK_"The procedure `isHead()` must be unbiased. There is a 5\sgima chance this test fails. Rerunning the test may resolve the failure.", int(__LINE__, IK))
42 :
43 4 : rand = isHead(size = NSIM)
44 80004 : assertion = assertion .and. logical(abs(NSIM / 2_IK - count(rand, kind = IK)) <= 5 * sqrt(real(NSIM / 2_IK)), LK)
45 4 : call test%assert(assertion, SK_"The procedure `isHead(size = NSIM)` must be unbiased. There is a 5\sgima chance this test fails. Rerunning the test may resolve the failure.", int(__LINE__, IK))
46 :
47 80004 : do i = 1_IK, NSIM
48 80004 : rand(i) = isHead(p = 1._RKC)
49 : end do
50 80004 : assertion = assertion .and. logical(all(rand), LK)
51 4 : call test%assert(assertion, SK_"The procedure `isHead(p = 1._RKC)` must always yield `.true.`.", int(__LINE__, IK))
52 :
53 80004 : do i = 1_IK, NSIM
54 80004 : rand(i) = isHead(p = 0._RKC)
55 : end do
56 80004 : assertion = assertion .and. logical(.not. any(rand), LK)
57 4 : call test%assert(assertion, SK_"The procedure `isHead(p = 0._RKC)` must always yield `.false.`.", int(__LINE__, IK))
58 :
59 4 : rand = isHead(p = 1._RKC, size = NSIM)
60 80004 : assertion = assertion .and. logical(all(rand), LK)
61 4 : call test%assert(assertion, SK_"The procedure `isHead(p = 1._RKC, size = NSIM)` must always yield `.true.`.", int(__LINE__, IK))
62 :
63 4 : rand = isHead(p = 0._RKC, size = NSIM)
64 80004 : assertion = assertion .and. logical(.not. any(rand), LK)
65 4 : call test%assert(assertion, SK_"The procedure `isHead(p = 0._RKC, size = NSIM)` must always yield `.false.`.", int(__LINE__, IK))
66 :
67 : !%%%%%%%%%%%%%%%%%%
68 : #elif getBernRand_ENABLED
69 : !%%%%%%%%%%%%%%%%%%
70 :
71 : integer(IK) :: i
72 : integer(IK) , parameter :: NSIM = 20000_IK
73 : integer(IK) :: rand(NSIM)
74 :
75 : assertion = .true._LK
76 :
77 80004 : do i = 1_IK, NSIM
78 80004 : rand(i) = getBernRand(p = .5_RKC)
79 : end do
80 80004 : assertion = assertion .and. logical(abs(NSIM / 2_IK - count(rand == 1_IK, kind = IK)) <= 5 * sqrt(real(NSIM / 2_IK)), LK)
81 4 : call test%assert(assertion, SK_"The procedure `getBernRand(p)` must be unbiased. There is a 5\sgima chance this test fails. Rerunning the test may resolve the failure.", int(__LINE__, IK))
82 :
83 4 : rand = getBernRand(p = .5_RKC, size = NSIM)
84 80004 : assertion = assertion .and. logical(abs(NSIM / 2_IK - count(rand == 1_IK, kind = IK)) <= 5 * sqrt(real(NSIM / 2_IK)), LK)
85 4 : call test%assert(assertion, SK_"The procedure `getBernRand(p, size = NSIM)` must be unbiased. There is a 5\sgima chance this test fails. Rerunning the test may resolve the failure.", int(__LINE__, IK))
86 :
87 80004 : do i = 1_IK, NSIM
88 80004 : rand(i) = getBernRand(p = 1._RKC)
89 : end do
90 80004 : assertion = assertion .and. logical(all(rand == 1_IK), LK)
91 4 : call test%assert(assertion, SK_"The procedure `getBernRand(p = 1._RKC)` must always yield `1`.", int(__LINE__, IK))
92 :
93 80004 : do i = 1_IK, NSIM
94 80004 : rand(i) = getBernRand(p = 0._RKC)
95 : end do
96 80004 : assertion = assertion .and. logical(.not. any(rand == 1_IK), LK)
97 4 : call test%assert(assertion, SK_"The procedure `getBernRand(p = 0._RKC)` must always yield `0`.", int(__LINE__, IK))
98 :
99 4 : rand = getBernRand(p = 1._RKC, size = NSIM)
100 80004 : assertion = assertion .and. logical(all(rand == 1_IK), LK)
101 4 : call test%assert(assertion, SK_"The procedure `getBernRand(p = 1._RKC, size = NSIM)` must always yield `1`.", int(__LINE__, IK))
102 :
103 4 : rand = getBernRand(p = 0._RKC, size = NSIM)
104 80004 : assertion = assertion .and. logical(.not. any(rand == 1_IK), LK)
105 4 : call test%assert(assertion, SK_"The procedure `getBernRand(p = 0._RKC, size = NSIM)` must always yield `0`.", int(__LINE__, IK))
106 :
107 : !%%%%%%%%%%%%%%%%%%
108 : #elif setBernRand_ENABLED
109 : !%%%%%%%%%%%%%%%%%%
110 :
111 : use pm_distUnif, only: getUnifRand
112 : integer(IK) :: i
113 : integer(IK) , parameter :: NSIM = 20000_IK
114 : #if IK_ENABLED
115 : #define IS_TRUE(x) x == 1_IKC
116 : integer(IKC) :: rand(NSIM)
117 : #elif LK_ENABLED
118 : #define IS_TRUE(x) x
119 : logical(LKC) :: rand(NSIM)
120 : #elif RK_ENABLED
121 : #define IS_TRUE(x) x == 1._RKC
122 : real(RKC) :: rand(NSIM)
123 : #else
124 : #error "Unrecognized interface."
125 : #endif
126 :
127 : assertion = .true._LK
128 :
129 880044 : do i = 1_IK, NSIM
130 880044 : call setBernRand(rand(i), getUnifRand(0._RKC, 1._RKC), p = .5_RKC)
131 : end do
132 880044 : assertion = assertion .and. logical(abs(NSIM / 2_IK - count(IS_TRUE(rand), kind = IK)) <= 5 * sqrt(real(NSIM / 2_IK)), LK)
133 44 : call test%assert(assertion, SK_"The procedure `getBernRand(p)` must be unbiased. There is a 5\sgima chance this test fails. Rerunning the test may resolve the failure.", int(__LINE__, IK))
134 :
135 880044 : call setBernRand(rand, getUnifRand(0._RKC, 1._RKC, size(rand, 1, IK)), p = .5_RKC)
136 880044 : assertion = assertion .and. logical(abs(NSIM / 2_IK - count(IS_TRUE(rand), kind = IK)) <= 5 * sqrt(real(NSIM / 2_IK)), LK)
137 44 : call test%assert(assertion, SK_"The procedure `getBernRand(p, size = NSIM)` must be unbiased. There is a 5\sgima chance this test fails. Rerunning the test may resolve the failure.", int(__LINE__, IK))
138 :
139 880044 : do i = 1_IK, NSIM
140 880044 : call setBernRand(rand(i), getUnifRand(0._RKC, 1._RKC), p = 1._RKC)
141 : end do
142 880044 : assertion = assertion .and. logical(all(IS_TRUE(rand)), LK)
143 44 : call test%assert(assertion, SK_"The procedure `getBernRand(p = 1._RKC)` must always yield `1`.", int(__LINE__, IK))
144 :
145 880044 : do i = 1_IK, NSIM
146 880044 : call setBernRand(rand(i), getUnifRand(0._RKC, 1._RKC), p = 0._RKC)
147 : end do
148 880044 : assertion = assertion .and. logical(.not. any(IS_TRUE(rand)), LK)
149 44 : call test%assert(assertion, SK_"The procedure `getBernRand(p = 0._RKC)` must always yield `0`.", int(__LINE__, IK))
150 :
151 880044 : call setBernRand(rand, getUnifRand(0._RKC, 1._RKC, size(rand, 1, IK)), p = 1._RKC)
152 880044 : assertion = assertion .and. logical(all(IS_TRUE(rand)), LK)
153 44 : call test%assert(assertion, SK_"The procedure `getBernRand(p = 1._RKC, size = NSIM)` must always yield `1`.", int(__LINE__, IK))
154 :
155 880044 : call setBernRand(rand, getUnifRand(0._RKC, 1._RKC, size(rand, 1, IK)), p = 0._RKC)
156 880044 : assertion = assertion .and. logical(.not. any(IS_TRUE(rand)), LK)
157 44 : call test%assert(assertion, SK_"The procedure `getBernRand(p = 0._RKC, size = NSIM)` must always yield `0`.", int(__LINE__, IK))
158 :
159 : #else
160 : !%%%%%%%%%%%%%%%%%%%%%%%%
161 : #error "Unrecognized interface."
162 : !%%%%%%%%%%%%%%%%%%%%%%%%
163 : #endif
164 : #undef IS_TRUE
|
