From b2ff4bec6f00bf430134eeeb7af9a8b3d062c7c3 Mon Sep 17 00:00:00 2001 From: gururaj1512 Date: Wed, 12 Nov 2025 23:43:13 +0530 Subject: [PATCH 1/2] feat: add method rvs-normal-array-default --- src/stdlib_stats_distribution_normal.fypp | 80 +++++++++++++++++++++++ test/stats/test_distribution_normal.fypp | 40 ++++++++++++ 2 files changed, 120 insertions(+) diff --git a/src/stdlib_stats_distribution_normal.fypp b/src/stdlib_stats_distribution_normal.fypp index 3ee50ea6f..0bdff92cf 100644 --- a/src/stdlib_stats_distribution_normal.fypp +++ b/src/stdlib_stats_distribution_normal.fypp @@ -34,6 +34,10 @@ module stdlib_stats_distribution_normal #:for k1, t1 in RC_KINDS_TYPES module procedure rvs_norm_array_${t1[0]}$${k1}$ !3 dummy variables #:endfor + + #:for k1, t1 in RC_KINDS_TYPES + module procedure rvs_norm_array_default_${t1[0]}$${k1}$ !2 dummy variables (mold, array_size) + #:endfor end interface rvs_normal interface pdf_normal @@ -238,6 +242,82 @@ contains #:endfor + #:for k1, t1 in REAL_KINDS_TYPES + impure function rvs_norm_array_default_${t1[0]}$${k1}$ (mold, array_size) result(res) + ! + ! Standard normal array random variate with default loc=0, scale=1 + ! The mold argument is used only to determine the type and is not referenced + ! + ${t1}$, intent(in) :: mold + integer, intent(in) :: array_size + ${t1}$ :: res(array_size) + ${t1}$, parameter :: r = 3.442619855899_${k1}$, rr = 1.0_${k1}$/r + ${t1}$ :: x, y, re + integer :: hz, iz, i + + if (.not. zig_norm_initialized) call zigset + + do i = 1, array_size + iz = 0 + hz = dist_rand(1_int32) + iz = iand(hz, 127) + if (abs(hz) < kn(iz)) then + re = hz*wn(iz) + else + L1: do + L2: if (iz == 0) then + do + x = -log(uni(1.0_${k1}$))*rr + y = -log(uni(1.0_${k1}$)) + if (y + y >= x*x) exit + end do + re = r + x + if (hz <= 0) re = -re + exit L1 + end if L2 + x = hz*wn(iz) + if (fn(iz) + uni(1.0_${k1}$)*(fn(iz - 1) - fn(iz)) < & + exp(-HALF*x*x)) then + re = x + exit L1 + end if + + hz = dist_rand(1_int32) + iz = iand(hz, 127) + if (abs(hz) < kn(iz)) then + re = hz*wn(iz) + exit L1 + end if + end do L1 + end if + res(i) = re ! Default: loc=0, scale=1, so re*1 + 0 = re + end do + end function rvs_norm_array_default_${t1[0]}$${k1}$ + + #:endfor + + #:for k1, t1 in CMPLX_KINDS_TYPES + impure function rvs_norm_array_default_${t1[0]}$${k1}$ (mold, array_size) result(res) + ! + ! Standard normal complex array random variate with default loc=0, scale=1 + ! The mold argument is used only to determine the type and is not referenced + ! + ${t1}$, intent(in) :: mold + integer, intent(in) :: array_size + integer :: i + ${t1}$ :: res(array_size) + real(${k1}$) :: tr, ti + + do i = 1, array_size + tr = rvs_norm_0_r${k1}$ () + ti = rvs_norm_0_r${k1}$ () + res(i) = cmplx(tr, ti, kind=${k1}$) + end do + + end function rvs_norm_array_default_${t1[0]}$${k1}$ + + #:endfor + #:for k1, t1 in CMPLX_KINDS_TYPES impure function rvs_norm_array_${t1[0]}$${k1}$ (loc, scale, array_size) result(res) ${t1}$, intent(in) :: loc, scale diff --git a/test/stats/test_distribution_normal.fypp b/test/stats/test_distribution_normal.fypp index 82e6faca7..89c0d711f 100644 --- a/test/stats/test_distribution_normal.fypp +++ b/test/stats/test_distribution_normal.fypp @@ -26,6 +26,10 @@ program test_distribution_normal call test_nor_rvs_${t1[0]}$${k1}$ #:endfor + #:for k1, t1 in RC_KINDS_TYPES + call test_nor_rvs_default_${t1[0]}$${k1}$ + #:endfor + #:for k1, t1 in RC_KINDS_TYPES @@ -138,6 +142,42 @@ contains #:endfor + #:for k1, t1 in RC_KINDS_TYPES + subroutine test_nor_rvs_default_${t1[0]}$${k1}$ + ${t1}$ :: a1(10), a2(10), mold + integer :: i + integer :: seed, get + + print *, "Test normal_distribution_rvs_default_${t1[0]}$${k1}$" + seed = 25836914 + call random_seed(seed, get) + + ! explicit form with loc=0, scale=1 + #:if t1[0] == "r" + a1 = nor_rvs(0.0_${k1}$, 1.0_${k1}$, 10) + #:else + a1 = nor_rvs((0.0_${k1}$, 0.0_${k1}$), (1.0_${k1}$, 1.0_${k1}$), 10) + #:endif + + ! reset seed to reproduce same random sequence + seed = 25836914 + call random_seed(seed, get) + + ! default mold form: mold used only to disambiguate kind + #:if t1[0] == "r" + mold = 0.0_${k1}$ + #:else + mold = (0.0_${k1}$, 0.0_${k1}$) + #:endif + + a2 = nor_rvs(mold, 10) + + call check(all(a1 == a2), msg="normal_distribution_rvs_default_${t1[0]}$${k1}$ failed", warn=warn) + end subroutine test_nor_rvs_default_${t1[0]}$${k1}$ + + #:endfor + + #:for k1, t1 in RC_KINDS_TYPES From c11973550304eb6abcc5f39996f2bd5b58a3f897 Mon Sep 17 00:00:00 2001 From: gururaj1512 Date: Sat, 15 Nov 2025 15:45:52 +0530 Subject: [PATCH 2/2] refactor as per suggested changes --- src/stdlib_stats_distribution_normal.fypp | 82 ++++++----------------- test/stats/test_distribution_normal.fypp | 2 +- 2 files changed, 20 insertions(+), 64 deletions(-) diff --git a/src/stdlib_stats_distribution_normal.fypp b/src/stdlib_stats_distribution_normal.fypp index 0bdff92cf..69201b648 100644 --- a/src/stdlib_stats_distribution_normal.fypp +++ b/src/stdlib_stats_distribution_normal.fypp @@ -33,9 +33,6 @@ module stdlib_stats_distribution_normal #:for k1, t1 in RC_KINDS_TYPES module procedure rvs_norm_array_${t1[0]}$${k1}$ !3 dummy variables - #:endfor - - #:for k1, t1 in RC_KINDS_TYPES module procedure rvs_norm_array_default_${t1[0]}$${k1}$ !2 dummy variables (mold, array_size) #:endfor end interface rvs_normal @@ -243,96 +240,55 @@ contains #:endfor #:for k1, t1 in REAL_KINDS_TYPES - impure function rvs_norm_array_default_${t1[0]}$${k1}$ (mold, array_size) result(res) + impure function rvs_norm_array_default_${t1[0]}$${k1}$ (array_size, mold) result(res) ! ! Standard normal array random variate with default loc=0, scale=1 ! The mold argument is used only to determine the type and is not referenced ! - ${t1}$, intent(in) :: mold integer, intent(in) :: array_size + ${t1}$, intent(in) :: mold ${t1}$ :: res(array_size) - ${t1}$, parameter :: r = 3.442619855899_${k1}$, rr = 1.0_${k1}$/r - ${t1}$ :: x, y, re - integer :: hz, iz, i - if (.not. zig_norm_initialized) call zigset + res = rvs_norm_array_${t1[0]}$${k1}$ (0.0_${k1}$, 1.0_${k1}$, array_size) - do i = 1, array_size - iz = 0 - hz = dist_rand(1_int32) - iz = iand(hz, 127) - if (abs(hz) < kn(iz)) then - re = hz*wn(iz) - else - L1: do - L2: if (iz == 0) then - do - x = -log(uni(1.0_${k1}$))*rr - y = -log(uni(1.0_${k1}$)) - if (y + y >= x*x) exit - end do - re = r + x - if (hz <= 0) re = -re - exit L1 - end if L2 - x = hz*wn(iz) - if (fn(iz) + uni(1.0_${k1}$)*(fn(iz - 1) - fn(iz)) < & - exp(-HALF*x*x)) then - re = x - exit L1 - end if - - hz = dist_rand(1_int32) - iz = iand(hz, 127) - if (abs(hz) < kn(iz)) then - re = hz*wn(iz) - exit L1 - end if - end do L1 - end if - res(i) = re ! Default: loc=0, scale=1, so re*1 + 0 = re - end do end function rvs_norm_array_default_${t1[0]}$${k1}$ #:endfor #:for k1, t1 in CMPLX_KINDS_TYPES - impure function rvs_norm_array_default_${t1[0]}$${k1}$ (mold, array_size) result(res) - ! - ! Standard normal complex array random variate with default loc=0, scale=1 - ! The mold argument is used only to determine the type and is not referenced - ! - ${t1}$, intent(in) :: mold + impure function rvs_norm_array_${t1[0]}$${k1}$ (loc, scale, array_size) result(res) + ${t1}$, intent(in) :: loc, scale integer, intent(in) :: array_size integer :: i ${t1}$ :: res(array_size) real(${k1}$) :: tr, ti do i = 1, array_size - tr = rvs_norm_0_r${k1}$ () - ti = rvs_norm_0_r${k1}$ () + tr = rvs_norm_r${k1}$ (loc%re, scale%re) + ti = rvs_norm_r${k1}$ (loc%im, scale%im) res(i) = cmplx(tr, ti, kind=${k1}$) end do - end function rvs_norm_array_default_${t1[0]}$${k1}$ + end function rvs_norm_array_${t1[0]}$${k1}$ #:endfor #:for k1, t1 in CMPLX_KINDS_TYPES - impure function rvs_norm_array_${t1[0]}$${k1}$ (loc, scale, array_size) result(res) - ${t1}$, intent(in) :: loc, scale + impure function rvs_norm_array_default_${t1[0]}$${k1}$ (array_size, mold) result(res) + ! + ! Standard normal complex array random variate with default loc=0, scale=1 + ! The mold argument is used only to determine the type and is not referenced + ! integer, intent(in) :: array_size - integer :: i + ${t1}$, intent(in) :: mold ${t1}$ :: res(array_size) - real(${k1}$) :: tr, ti - do i = 1, array_size - tr = rvs_norm_r${k1}$ (loc%re, scale%re) - ti = rvs_norm_r${k1}$ (loc%im, scale%im) - res(i) = cmplx(tr, ti, kind=${k1}$) - end do + ! Call the full procedure with default loc=(0,0), scale=(1,1) + res = rvs_norm_array_${t1[0]}$${k1}$ (cmplx(0.0_${k1}$, 0.0_${k1}$, kind=${k1}$), & + cmplx(1.0_${k1}$, 1.0_${k1}$, kind=${k1}$), & + array_size) - end function rvs_norm_array_${t1[0]}$${k1}$ + end function rvs_norm_array_default_${t1[0]}$${k1}$ #:endfor diff --git a/test/stats/test_distribution_normal.fypp b/test/stats/test_distribution_normal.fypp index 89c0d711f..8e959fab1 100644 --- a/test/stats/test_distribution_normal.fypp +++ b/test/stats/test_distribution_normal.fypp @@ -170,7 +170,7 @@ contains mold = (0.0_${k1}$, 0.0_${k1}$) #:endif - a2 = nor_rvs(mold, 10) + a2 = nor_rvs(10, mold) call check(all(a1 == a2), msg="normal_distribution_rvs_default_${t1[0]}$${k1}$ failed", warn=warn) end subroutine test_nor_rvs_default_${t1[0]}$${k1}$