Skip to content

Commit b2ff4be

Browse files
committed
feat: add method rvs-normal-array-default
1 parent fffe0d7 commit b2ff4be

File tree

2 files changed

+120
-0
lines changed

2 files changed

+120
-0
lines changed

src/stdlib_stats_distribution_normal.fypp

Lines changed: 80 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,10 @@ module stdlib_stats_distribution_normal
3434
#:for k1, t1 in RC_KINDS_TYPES
3535
module procedure rvs_norm_array_${t1[0]}$${k1}$ !3 dummy variables
3636
#:endfor
37+
38+
#:for k1, t1 in RC_KINDS_TYPES
39+
module procedure rvs_norm_array_default_${t1[0]}$${k1}$ !2 dummy variables (mold, array_size)
40+
#:endfor
3741
end interface rvs_normal
3842

3943
interface pdf_normal
@@ -238,6 +242,82 @@ contains
238242

239243
#:endfor
240244

245+
#:for k1, t1 in REAL_KINDS_TYPES
246+
impure function rvs_norm_array_default_${t1[0]}$${k1}$ (mold, array_size) result(res)
247+
!
248+
! Standard normal array random variate with default loc=0, scale=1
249+
! The mold argument is used only to determine the type and is not referenced
250+
!
251+
${t1}$, intent(in) :: mold
252+
integer, intent(in) :: array_size
253+
${t1}$ :: res(array_size)
254+
${t1}$, parameter :: r = 3.442619855899_${k1}$, rr = 1.0_${k1}$/r
255+
${t1}$ :: x, y, re
256+
integer :: hz, iz, i
257+
258+
if (.not. zig_norm_initialized) call zigset
259+
260+
do i = 1, array_size
261+
iz = 0
262+
hz = dist_rand(1_int32)
263+
iz = iand(hz, 127)
264+
if (abs(hz) < kn(iz)) then
265+
re = hz*wn(iz)
266+
else
267+
L1: do
268+
L2: if (iz == 0) then
269+
do
270+
x = -log(uni(1.0_${k1}$))*rr
271+
y = -log(uni(1.0_${k1}$))
272+
if (y + y >= x*x) exit
273+
end do
274+
re = r + x
275+
if (hz <= 0) re = -re
276+
exit L1
277+
end if L2
278+
x = hz*wn(iz)
279+
if (fn(iz) + uni(1.0_${k1}$)*(fn(iz - 1) - fn(iz)) < &
280+
exp(-HALF*x*x)) then
281+
re = x
282+
exit L1
283+
end if
284+
285+
hz = dist_rand(1_int32)
286+
iz = iand(hz, 127)
287+
if (abs(hz) < kn(iz)) then
288+
re = hz*wn(iz)
289+
exit L1
290+
end if
291+
end do L1
292+
end if
293+
res(i) = re ! Default: loc=0, scale=1, so re*1 + 0 = re
294+
end do
295+
end function rvs_norm_array_default_${t1[0]}$${k1}$
296+
297+
#:endfor
298+
299+
#:for k1, t1 in CMPLX_KINDS_TYPES
300+
impure function rvs_norm_array_default_${t1[0]}$${k1}$ (mold, array_size) result(res)
301+
!
302+
! Standard normal complex array random variate with default loc=0, scale=1
303+
! The mold argument is used only to determine the type and is not referenced
304+
!
305+
${t1}$, intent(in) :: mold
306+
integer, intent(in) :: array_size
307+
integer :: i
308+
${t1}$ :: res(array_size)
309+
real(${k1}$) :: tr, ti
310+
311+
do i = 1, array_size
312+
tr = rvs_norm_0_r${k1}$ ()
313+
ti = rvs_norm_0_r${k1}$ ()
314+
res(i) = cmplx(tr, ti, kind=${k1}$)
315+
end do
316+
317+
end function rvs_norm_array_default_${t1[0]}$${k1}$
318+
319+
#:endfor
320+
241321
#:for k1, t1 in CMPLX_KINDS_TYPES
242322
impure function rvs_norm_array_${t1[0]}$${k1}$ (loc, scale, array_size) result(res)
243323
${t1}$, intent(in) :: loc, scale

test/stats/test_distribution_normal.fypp

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,10 @@ program test_distribution_normal
2626
call test_nor_rvs_${t1[0]}$${k1}$
2727
#:endfor
2828

29+
#:for k1, t1 in RC_KINDS_TYPES
30+
call test_nor_rvs_default_${t1[0]}$${k1}$
31+
#:endfor
32+
2933

3034

3135
#:for k1, t1 in RC_KINDS_TYPES
@@ -138,6 +142,42 @@ contains
138142
#:endfor
139143

140144

145+
#:for k1, t1 in RC_KINDS_TYPES
146+
subroutine test_nor_rvs_default_${t1[0]}$${k1}$
147+
${t1}$ :: a1(10), a2(10), mold
148+
integer :: i
149+
integer :: seed, get
150+
151+
print *, "Test normal_distribution_rvs_default_${t1[0]}$${k1}$"
152+
seed = 25836914
153+
call random_seed(seed, get)
154+
155+
! explicit form with loc=0, scale=1
156+
#:if t1[0] == "r"
157+
a1 = nor_rvs(0.0_${k1}$, 1.0_${k1}$, 10)
158+
#:else
159+
a1 = nor_rvs((0.0_${k1}$, 0.0_${k1}$), (1.0_${k1}$, 1.0_${k1}$), 10)
160+
#:endif
161+
162+
! reset seed to reproduce same random sequence
163+
seed = 25836914
164+
call random_seed(seed, get)
165+
166+
! default mold form: mold used only to disambiguate kind
167+
#:if t1[0] == "r"
168+
mold = 0.0_${k1}$
169+
#:else
170+
mold = (0.0_${k1}$, 0.0_${k1}$)
171+
#:endif
172+
173+
a2 = nor_rvs(mold, 10)
174+
175+
call check(all(a1 == a2), msg="normal_distribution_rvs_default_${t1[0]}$${k1}$ failed", warn=warn)
176+
end subroutine test_nor_rvs_default_${t1[0]}$${k1}$
177+
178+
#:endfor
179+
180+
141181

142182

143183
#:for k1, t1 in RC_KINDS_TYPES

0 commit comments

Comments
 (0)