From 8061a1fba37014b927f79c50bb814e434d207dc5 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 16:32:32 -0500 Subject: [PATCH 01/55] initial commit --- src/CMakeLists.txt | 2 +- src/Makefile.manual | 10 +- ...stdlib_stats_distribution_exponential.fypp | 331 ++++++++++++++++++ 3 files changed, 337 insertions(+), 6 deletions(-) create mode 100644 src/stdlib_stats_distribution_exponential.fypp diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index b1157149e..33144ad07 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -20,7 +20,7 @@ set(fppFiles stdlib_quadrature_simps.fypp stdlib_stats_distribution_PRNG.fypp stdlib_stats_distribution_uniform.fypp - stdlib_stats_distribution_normal.fypp + stdlib_stats_distribution_normal.fypp ) diff --git a/src/Makefile.manual b/src/Makefile.manual index bbab36e42..725b4aec9 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -18,7 +18,7 @@ SRC = f18estop.f90 \ stdlib_stats_var.f90 \ stdlib_stats_distribution_PRNG.f90\ stdlib_stats_distribution_uniform.f90 \ - stdlib_stats_distribution_normal.f90 + stdlib_stats_distribution_normal.f90 LIB = libstdlib.a @@ -77,9 +77,9 @@ stdlib_stats_distribution_uniform.o: \ stdlib_stats_distribution_PRNG.o stdlib_stats_distribution_normal.o \ stdlib_kinds.o - stdlib_error.o \ - stdlib_stats_distribution.PRNG.o \ - stdlib_stats_distribution.uniform.o + stdlib_error.o \ + stdlib_stats_distribution.PRNG.o \ + stdlib_stats_distribution.uniform.o # Fortran sources that are built from fypp templates stdlib_bitsets_64.f90: stdlib_bitsets_64.fypp @@ -95,4 +95,4 @@ stdlib_stats_moment.f90: stdlib_stats_moment.fypp stdlib_stats_var.f90: stdlib_stats_var.fypp stdlib_stats_distribution_PRNG.f90: stdlib_stats_distribution_PRNG.fypp stdlib_stats_distribution_uniform.f90: stdlib_stats_distribution_uniform.fypp -stdlib_stats_distribution_normal.f90: stdlib_stats_distribution_normal.fypp +stdlib_stats_distribution_normal.f90: stdlib_stats_distribution_normal.fypp \ No newline at end of file diff --git a/src/stdlib_stats_distribution_exponential.fypp b/src/stdlib_stats_distribution_exponential.fypp new file mode 100644 index 000000000..6a3784bd8 --- /dev/null +++ b/src/stdlib_stats_distribution_exponential.fypp @@ -0,0 +1,331 @@ +#:include "common.fypp" +#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES +Module stdlib_stats_distribution_expon + use stdlib_kinds + use stdlib_error, only : error_stop + use stdlib_stats_distribution_PRNG, only : dist_rand + use stdlib_stats_distribution_uniform, only : uni=>uniform_distribution_rvs + + implicit none + private + real(dp), parameter :: HALF = 0.5_dp, ONE = 1.0_dp, TWO = 2.0_dp + integer, save :: ke(0:255) + real(dp), save :: we(0:255), fe(0:255) + logical, save :: zig_exp_initialized = .false. + + public :: exponential_distribution_rvs + public :: exponential_distribution_pdf + public :: exponential_distribution_cdf + + interface exponential_distribution_rvs + !! Version experimental + !! + !! Exponential Distribution Random Variates + !!([Specification](../page/specs/stdlib_stats_distribution_expon.html# + !! description)) + !! + module procedure exp_dist_rvs_0_rsp !0 dummy variable + + #:for k1, t1 in RC_KINDS_TYPES + module procedure exp_dist_rvs_${t1[0]}$${k1}$ !1 dummy variable + #:endfor + + #:for k1, t1 in RC_KINDS_TYPES + module procedure exp_dist_rvs_array_${t1[0]}$${k1}$ !2 dummy variables + #:endfor + end interface exponential_distribution_rvs + + interface exponential_distribution_pdf + !! Version experimental + !! + !! Exponential Distribution Probability Density Function + !!([Specification](../page/specs/stdlib_stats_distribution_expon.html# + !! description)) + !! + #:for k1, t1 in RC_KINDS_TYPES + module procedure exp_dist_pdf_${t1[0]}$${k1}$ + #:endfor + end interface exponential_distribution_pdf + + interface exponential_distribution_cdf + !! Version experimental + !! + !! Exponential Distribution Cumulative Distribution Function + !! ([Specification](../page/specs/stdlib_stats_distribution_expon.html# + !! description)) + !! + #:for k1, t1 in RC_KINDS_TYPES + module procedure exp_dist_cdf_${t1[0]}$${k1}$ + #:endfor + end interface exponential_distribution_cdf + + + contains + + subroutine zigset + ! Marsaglia & Tsang generator for random normals & random exponentials. + ! Translated from C by Alan Miller (amiller@bigpond.net.au) + ! + ! Marsaglia, G. & Tsang, W.W. (2000) `The ziggurat method for generating + ! random variables', J. Statist. Software, v5(8). + ! + ! This is an electronic journal which can be downloaded from: + ! http://www.jstatsoft.org/v05/i08 + ! + ! N.B. It is assumed that all integers are 32-bit. + ! N.B. The value of M2 has been halved to compensate for the lack of + ! unsigned integers in Fortran. + ! + ! Latest version - 1 January 2001 + ! + real(dp), parameter :: M2 = 2147483648.0_dp + real(dp) :: de = 7.697117470131487_dp, te, & + ve = 0.003949659822581572_dp, q + integer :: i + + te = de + ! tables for random exponetials + q = ve * exp( de ) + ke(0) = int((de / q) * M2, kind = int32) + ke(1) = 0 + we(0) = q / M2 + we(255) = de / M2 + fe(0) = ONE + fe(255) = exp( -de ) + do i = 254, 1, -1 + de = -log( ve / de + exp( -de ) ) + ke(i+1) = int(M2 * (de / te), kind = int32) + te = de + fe(i) = exp( -de ) + we(i) = de / M2 + end do + zig_exp_initialized = .true. + return + end subroutine zigset + + #:for k1, t1 in REAL_KINDS_TYPES + impure elemental function exp_dist_rvs_0_${t1[0]}$${k1}$( ) result(res) + ! Exponential distributed random variate with lamda = 1 + ! + ${t1}$ :: res, x + ${t1}$ :: r = 7.69711747013104972_${k1}$ + integer :: jz, iz + + if( .not. zig_exp_initialized ) call zigset + + ! Original algorithm use 32bit + iz = 0 + jz = dist_rand(iz) + + iz = iand( jz, 255 ) + if( abs( jz ) < ke(iz) ) then + res = abs(jz) * we(iz) + else + L1: do + if( iz == 0 ) then + res = r - log( uni( ) ) + exit L1 + end if + x = abs( jz ) * we(iz) + if( fe(iz) + uni( ) * (fe(iz-1) - fe(iz)) < exp( -x ) ) then + res = x + exit L1 + end if + + !original algorithm use 32bit + jz = dist_rand(iz) + iz = iand( jz, 255 ) + if( abs( jz ) < ke(iz) ) then + res = abs( jz ) * we(iz) + exit L1 + end if + end do L1 + endif + return + end function exp_dist_rvs_0_${t1[0]}$${k1}$ + + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + impure elemental function exp_dist_rvs_${t1[0]}$${k1}$(lamda) result(res) + ! Exponential distributed random variate + ! + ${t1}$, intent(in) :: lamda + ${t1}$ :: res, x + ${t1}$ :: r = 7.69711747013104972_${k1}$ + integer(int32) :: jz, iz + + if(lamda <= 0.0_${k1}$) call error_stop("Error: Exponential" & + //" distribution lamda parameter must be greaeter than zero") + if( .not. zig_exp_initialized ) call zigset + + ! Original algorithm use 32bit + iz = 0 + jz = dist_rand(iz) + + iz = iand( jz, 255 ) + if( abs( jz ) < ke(iz) ) then + res = abs(jz) * we(iz) + else + L1: do + if( iz == 0 ) then + res = r - log( uni( ) ) + exit L1 + end if + x = abs( jz ) * we(iz) + if( fe(iz) + uni( ) * (fe(iz-1) - fe(iz)) < exp( -x ) ) then + res = x + exit L1 + end if + + !original algorithm use 32bit + jz = dist_rand(iz) + iz = iand( jz, 255 ) + if( abs( jz ) < ke(iz) ) then + res = abs( jz ) * we(iz) + exit L1 + end if + end do L1 + endif + res = res * lamda + return + end function exp_dist_rvs_${t1[0]}$${k1}$ + + #:endfor + + #:for k1, t1 in CMPLX_KINDS_TYPES + impure elemental function exp_dist_rvs_${t1[0]}$${k1}$(lamda) result(res) + ${t1}$, intent(in) :: lamda + ${t1}$ :: res + real(${k1}$) :: tr, ti + + tr = exp_dist_rvs_r${k1}$(real(lamda)) + ti = exp_dist_rvs_r${k1}$(aimag(lamda)) + res = cmplx(tr, ti) + return + end function exp_dist_rvs_${t1[0]}$${k1}$ + + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + function exp_dist_rvs_array_${t1[0]}$${k1}$(lamda, array_size) result(res) + ${t1}$, intent(in) :: lamda + ${t1}$, allocatable :: res(:) + integer, intent(in) :: array_size + ${t1}$ :: x, re + ${t1}$ :: r = 7.69711747013104972_${k1}$ + integer :: jz, iz, i + + if(lamda <= 0.0_${k1}$) call error_stop("Error: Exponential" & + //" distribution lamda parameter must be greaeter than zero") + if( .not. zig_exp_initialized ) call zigset + allocate(res(array_size)) + do i =1, array_size + ! Original algorithm use 32bit + iz = 0 + jz = dist_rand(iz) + + iz = iand( jz, 255 ) + if( abs( jz ) < ke(iz) ) then + re = abs(jz) * we(iz) + else + L1: do + if( iz == 0 ) then + re = r - log( uni( ) ) + exit L1 + end if + x = abs( jz ) * we(iz) + if( fe(iz) + uni( ) * (fe(iz-1) - fe(iz)) < exp( -x ) ) then + re = x + exit L1 + end if + + !original algorithm use 32bit + jz = dist_rand(iz) + iz = iand( jz, 255 ) + if( abs( jz ) < ke(iz) ) then + re = abs( jz ) * we(iz) + exit L1 + end if + end do L1 + endif + res(i) = re * lamda + end do + return + end function exp_dist_rvs_array_${t1[0]}$${k1}$ + + #:endfor + + #:for k1, t1 in CMPLX_KINDS_TYPES + function exp_dist_rvs_array_${t1[0]}$${k1}$(lamda, array_size) result(res) + ${t1}$, intent(in) :: lamda + integer, intent(in) :: array_size + ${t1}$, allocatable :: res(:) + integer :: i + real(${k1}$) :: tr, ti + + allocate(res(array_size)) + do i = 1, array_size + tr = exp_dist_rvs_r${k1}$(real(lamda)) + ti = exp_dist_rvs_r${k1}$(aimag(lamda)) + res(i) = cmplx(tr, ti) + end do + return + end function exp_dist_rvs_array_${t1[0]}$${k1}$ + + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + impure elemental function exp_dist_pdf_${t1[0]}$${k1}$(x, lamda) result(res) + ! Exponential Distribution Probability Density Function + ! + ${t1}$, intent(in) :: x, lamda + real :: res + + if(lamda <= 0.0_${k1}$) call error_stop("Error: Exponential" & + //" distribution lamda parameter must be greaeter than zero") + res = exp(- x * lamda) * lamda + return + end function exp_dist_pdf_${t1[0]}$${k1}$ + + #:endfor + + #:for k1, t1 in CMPLX_KINDS_TYPES + impure elemental function exp_dist_pdf_${t1[0]}$${k1}$(x, lamda) result(res) + ${t1}$, intent(in) :: x, lamda + real :: res + + res = exp_dist_pdf_r${k1}$(real(x), real(lamda)) + res = res * exp_dist_pdf_r${k1}$(aimag(x), aimag(lamda)) + return + end function exp_dist_pdf_${t1[0]}$${k1}$ + + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + impure elemental function exp_dist_cdf_${t1[0]}$${k1}$(x, lamda) result(res) + ! Exponential Cumulative Distribution Function + ! + ${t1}$, intent(in) :: x, lamda + real :: res + + if(lamda <= 0.0_${k1}$) call error_stop("Error: Exponential" & + //" distribution lamda parameter must be greaeter than zero") + res = (1.0 - exp(- x * lamda)) + return + end function exp_dist_cdf_${t1[0]}$${k1}$ + + #:endfor + + #:for k1, t1 in CMPLX_KINDS_TYPES + impure elemental function exp_dist_cdf_${t1[0]}$${k1}$(x, lamda) result(res) + ${t1}$, intent(in) :: x, lamda + real :: res + + res = exp_dist_cdf_r${k1}$(real(x), real(lamda)) + res = res * exp_dist_cdf_r${k1}$(aimag(x), aimag(lamda)) + return + end function exp_dist_cdf_${t1[0]}$${k1}$ + + #:endfor +end module stdlib_stats_distribution_expon \ No newline at end of file From 07dbee953af92837a921cf80fe6a2a165970dd82 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 16:34:13 -0500 Subject: [PATCH 02/55] initial commit --- .../stats/test_distribution_exponential.f90 | 540 ++++++++++++++++++ 1 file changed, 540 insertions(+) create mode 100644 src/tests/stats/test_distribution_exponential.f90 diff --git a/src/tests/stats/test_distribution_exponential.f90 b/src/tests/stats/test_distribution_exponential.f90 new file mode 100644 index 000000000..3773ad9b9 --- /dev/null +++ b/src/tests/stats/test_distribution_exponential.f90 @@ -0,0 +1,540 @@ +program test_distribution_expon + use stdlib_kinds + use stdlib_error, only : check + use stdlib_stats_distribution_PRNG, only : random_seed + use stdlib_stats_distribution_expon, only : & + expon_rvs => exponential_distribution_rvs, & + expon_pdf => exponential_distribution_pdf, & + expon_cdf => exponential_distribution_cdf + + implicit none + real(sp), parameter :: sptol = 1000 * epsilon(1.0_sp) + real(dp), parameter :: dptol = 1000 * epsilon(1.0_dp) + real(qp), parameter :: qptol = 1000 * epsilon(1.0_qp) + logical :: warn = .true. + integer :: put, get + + put = 12345678 + call random_seed(put, get) + + call test_exponential_random_generator + + call test_expon_rvs_rsp + call test_expon_rvs_rdp + call test_expon_rvs_rqp + call test_expon_rvs_csp + call test_expon_rvs_cdp + call test_expon_rvs_cqp + + call test_expon_pdf_rsp + call test_expon_pdf_rdp + call test_expon_pdf_rqp + call test_expon_pdf_csp + call test_expon_pdf_cdp + call test_expon_pdf_cqp + + call test_expon_cdf_rsp + call test_expon_cdf_rdp + call test_expon_cdf_rqp + call test_expon_cdf_csp + call test_expon_cdf_cdp + call test_expon_cdf_cqp + + + contains + + subroutine test_exponential_random_generator + integer :: i, j, freq(0:1000), num=10000000 + real(dp) :: chisq, expct + + print *, "" + print *, "Test exponential random generator with chi-squared" + freq = 0 + do i = 1, num + j = 1000 * (1.0 - exp(- expon_rvs(1.0))) + freq(j) = freq(j) + 1 + end do + chisq = 0.0_dp + expct = num / 1000 + do i = 0, 999 + chisq = chisq + (freq(i) - expct) ** 2 / expct + end do + write(*,*) "The critical values for chi-squared with 1000 d. of f. is" & + //" 1143.92" + write(*,*) "Chi-squared for exponential random generator is : ", chisq + call check((chisq < 1143.9), & + msg="exponential randomness failed chi-squared test", warn=warn) + end subroutine test_exponential_random_generator + + subroutine test_expon_rvs_rsp + real(sp) :: res(10), scale + integer :: i, n, k = 5 + integer :: seed, get + real(sp) :: ans(10) = [1.37178108290154243675829093263018876_sp, & + 0.309467303067628429769087006206973456_sp, & + 0.303573393522570872393728791394096334_sp, & + 3.00973636550766943109636031294940040_sp, & + 0.250084097046766984373533659891108982_sp, & + 1.20139122141795795517538181229610927_sp, & + 4.43019214257137261547825346497120336_sp, & + 0.835001950484080046610557701569632627_sp, & + 1.82681711031524329769126779865473509_sp, & + 0.910435173630070204708886194566730410_sp] + + print *, "Test exponential_distribution_rvs_rsp" + seed = 593742186 + call random_seed(seed, get) + scale = 1.5_sp + do i = 1, 5 + res(i) = expon_rvs(scale) + end do + res(6:10) = expon_rvs(scale, k) + call check(all(abs(res - ans) < sptol), & + msg="exponential_distribution_rvs_rsp failed", warn=warn) + end subroutine test_expon_rvs_rsp + + subroutine test_expon_rvs_rdp + real(dp) :: res(10), scale + integer :: i, n, k = 5 + integer :: seed, get + real(dp) :: ans(10) = [1.37178108290154243675829093263018876_dp, & + 0.309467303067628429769087006206973456_dp, & + 0.303573393522570872393728791394096334_dp, & + 3.00973636550766943109636031294940040_dp, & + 0.250084097046766984373533659891108982_dp, & + 1.20139122141795795517538181229610927_dp, & + 4.43019214257137261547825346497120336_dp, & + 0.835001950484080046610557701569632627_dp, & + 1.82681711031524329769126779865473509_dp, & + 0.910435173630070204708886194566730410_dp] + + print *, "Test exponential_distribution_rvs_rdp" + seed = 593742186 + call random_seed(seed, get) + scale = 1.5_dp + do i = 1, 5 + res(i) = expon_rvs(scale) + end do + res(6:10) = expon_rvs(scale, k) + call check(all(abs(res - ans) < dptol), & + msg="exponential_distribution_rvs_rdp failed", warn=warn) + end subroutine test_expon_rvs_rdp + + subroutine test_expon_rvs_rqp + real(qp) :: res(10), scale + integer :: i, n, k = 5 + integer :: seed, get + real(qp) :: ans(10) = [1.37178108290154243675829093263018876_qp, & + 0.309467303067628429769087006206973456_qp, & + 0.303573393522570872393728791394096334_qp, & + 3.00973636550766943109636031294940040_qp, & + 0.250084097046766984373533659891108982_qp, & + 1.20139122141795795517538181229610927_qp, & + 4.43019214257137261547825346497120336_qp, & + 0.835001950484080046610557701569632627_qp, & + 1.82681711031524329769126779865473509_qp, & + 0.910435173630070204708886194566730410_qp] + + print *, "Test exponential_distribution_rvs_rqp" + seed = 593742186 + call random_seed(seed, get) + scale = 1.5_qp + do i = 1, 5 + res(i) = expon_rvs(scale) + end do + res(6:10) = expon_rvs(scale, k) + call check(all(abs(res - ans) < qptol), & + msg="exponential_distribution_rvs_rqp failed", warn=warn) + end subroutine test_expon_rvs_rqp + + subroutine test_expon_rvs_csp + complex(sp) :: res(10), scale + integer :: i, n, k = 5 + integer :: seed, get + complex(sp) :: ans(10) = [(0.640164494514465332031250000000000000_sp, & + 0.268204987049102783203125000000000000_sp), & + (0.141667589545249938964843750000000000_sp, & + 2.60843825340270996093750000000000000_sp), & + (0.116705909371376037597656250000000000_sp, & + 1.04120576381683349609375000000000000_sp), & + (2.06742310523986816406250000000000000_sp, & + 0.723668336868286132812500000000000000_sp), & + (0.852514624595642089843750000000000000_sp, & + 0.789043843746185302734375000000000000_sp), & + (1.09098446369171142578125000000000000_sp, & + 1.48569476604461669921875000000000000_sp), & + (4.29633092880249023437500000000000000_sp, & + 0.338216394186019897460937500000000000_sp), & + (0.340462744235992431640625000000000000_sp, & + 0.172319442033767700195312500000000000_sp), & + (6.932352483272552490234375000000000000E-0002_sp, & + 6.742518395185470581054687500000000000E-0002_sp), & + (1.03231632709503173828125000000000000_sp, & + 0.421413004398345947265625000000000000_sp)] + + print *, "Test exponential_distribution_rvs_csp" + seed = 593742186 + call random_seed(seed, get) + scale = (0.7_sp, 1.3_sp) + do i = 1, 5 + res(i) = expon_rvs(scale) + end do + res(6:10) = expon_rvs(scale, k) + call check(all(abs(res - ans) < sptol), & + msg="exponential_distribution_rvs_csp failed", warn=warn) + end subroutine test_expon_rvs_csp + + subroutine test_expon_rvs_cdp + complex(dp) :: res(10), scale + integer :: i, n, k = 5 + integer :: seed, get + complex(dp) :: ans(10) = [(0.640164494514465332031250000000000000_dp, & + 0.268204987049102783203125000000000000_dp), & + (0.141667589545249938964843750000000000_dp, & + 2.60843825340270996093750000000000000_dp), & + (0.116705909371376037597656250000000000_dp, & + 1.04120576381683349609375000000000000_dp), & + (2.06742310523986816406250000000000000_dp, & + 0.723668336868286132812500000000000000_dp), & + (0.852514624595642089843750000000000000_dp, & + 0.789043843746185302734375000000000000_dp), & + (1.09098446369171142578125000000000000_dp, & + 1.48569476604461669921875000000000000_dp), & + (4.29633092880249023437500000000000000_dp, & + 0.338216394186019897460937500000000000_dp), & + (0.340462744235992431640625000000000000_dp, & + 0.172319442033767700195312500000000000_dp), & + (6.932352483272552490234375000000000000E-0002_dp, & + 6.742518395185470581054687500000000000E-0002_dp), & + (1.03231632709503173828125000000000000_dp, & + 0.421413004398345947265625000000000000_dp)] + + print *, "Test exponential_distribution_rvs_cdp" + seed = 593742186 + call random_seed(seed, get) + scale = (0.7_dp, 1.3_dp) + do i = 1, 5 + res(i) = expon_rvs(scale) + end do + res(6:10) = expon_rvs(scale, k) + call check(all(abs(res - ans) < dptol), & + msg="exponential_distribution_rvs_cdp failed", warn=warn) + end subroutine test_expon_rvs_cdp + + subroutine test_expon_rvs_cqp + complex(qp) :: res(10), scale + integer :: i, n, k = 5 + integer :: seed, get + complex(qp) :: ans(10) = [(0.640164494514465332031250000000000000_qp, & + 0.268204987049102783203125000000000000_qp), & + (0.141667589545249938964843750000000000_qp, & + 2.60843825340270996093750000000000000_qp), & + (0.116705909371376037597656250000000000_qp, & + 1.04120576381683349609375000000000000_qp), & + (2.06742310523986816406250000000000000_qp, & + 0.723668336868286132812500000000000000_qp), & + (0.852514624595642089843750000000000000_qp, & + 0.789043843746185302734375000000000000_qp), & + (1.09098446369171142578125000000000000_qp, & + 1.48569476604461669921875000000000000_qp), & + (4.29633092880249023437500000000000000_qp, & + 0.338216394186019897460937500000000000_qp), & + (0.340462744235992431640625000000000000_qp, & + 0.172319442033767700195312500000000000_qp), & + (6.932352483272552490234375000000000000E-0002_qp, & + 6.742518395185470581054687500000000000E-0002_qp), & + (1.03231632709503173828125000000000000_qp, & + 0.421413004398345947265625000000000000_qp)] + + print *, "Test exponential_distribution_rvs_cqp" + seed = 593742186 + call random_seed(seed, get) + scale = (0.7_qp, 1.3_qp) + do i = 1, 5 + res(i) = expon_rvs(scale) + end do + res(6:10) = expon_rvs(scale, k) + call check(all(abs(res - ans) < qptol), & + msg="exponential_distribution_rvs_cqp failed", warn=warn) + end subroutine test_expon_rvs_cqp + + + + subroutine test_expon_pdf_rsp + real(sp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [6.14960417E-02, 6.14960417E-02, 6.14960417E-02, & + 1.38718796, 0.729365528, 1.67107172E-02, 0.296734482,& + 2.36971565E-02, 4.06475700E-02, 1.18497872, & + 8.39852914E-02, 1.36920142, 1.54058458E-02, & + 3.20194475E-02, 0.603879571] + + print *, "Test exponential_distribution_pdf_rsp" + seed = 123987654 + call random_seed(seed, get) + scale = 1.5_sp + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_pdf(x1, scale) + res(:, 2:5) = expon_pdf(x2, scale) + call check(all(abs(res - reshape(ans, [3,5])) < sptol), & + msg="exponential_distribution_pdf_rsp failed", warn=warn) + end subroutine test_expon_pdf_rsp + + subroutine test_expon_pdf_rdp + real(dp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [6.14960417E-02, 6.14960417E-02, 6.14960417E-02, & + 1.38718796, 0.729365528, 1.67107172E-02, 0.296734482,& + 2.36971565E-02, 4.06475700E-02, 1.18497872, & + 8.39852914E-02, 1.36920142, 1.54058458E-02, & + 3.20194475E-02, 0.603879571] + + print *, "Test exponential_distribution_pdf_rdp" + seed = 123987654 + call random_seed(seed, get) + scale = 1.5_dp + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_pdf(x1, scale) + res(:, 2:5) = expon_pdf(x2, scale) + call check(all(abs(res - reshape(ans, [3,5])) < dptol), & + msg="exponential_distribution_pdf_rdp failed", warn=warn) + end subroutine test_expon_pdf_rdp + + subroutine test_expon_pdf_rqp + real(qp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [6.14960417E-02, 6.14960417E-02, 6.14960417E-02, & + 1.38718796, 0.729365528, 1.67107172E-02, 0.296734482,& + 2.36971565E-02, 4.06475700E-02, 1.18497872, & + 8.39852914E-02, 1.36920142, 1.54058458E-02, & + 3.20194475E-02, 0.603879571] + + print *, "Test exponential_distribution_pdf_rqp" + seed = 123987654 + call random_seed(seed, get) + scale = 1.5_qp + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_pdf(x1, scale) + res(:, 2:5) = expon_pdf(x2, scale) + call check(all(abs(res - reshape(ans, [3,5])) < qptol), & + msg="exponential_distribution_pdf_rqp failed", warn=warn) + end subroutine test_expon_pdf_rqp + + subroutine test_expon_pdf_csp + complex(sp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [0.386471182, 0.386471182,0.386471182, 2.79592816E-03,& + 4.01333207E-03, 0.317740440, 0.385551631, & + 5.02163824E-03, 0.372386932, 6.09764457E-03, & + 0.273956627, 0.407586545, 1.59074634E-03,0.136133015,& + 0.399842113] + + print *, "Test exponential_distribution_pdf_csp" + seed = 123987654 + call random_seed(seed, get) + scale = (0.3_sp, 1.6_sp) + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_pdf(x1, scale) + res(:, 2:5) = expon_pdf(x2, scale) + call check(all(abs(res - reshape(ans, [3,5])) < sptol), & + msg="exponential_distribution_pdf_csp failed", warn=warn) + end subroutine test_expon_pdf_csp + + subroutine test_expon_pdf_cdp + complex(dp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [0.386471182, 0.386471182,0.386471182, 2.79592816E-03,& + 4.01333207E-03, 0.317740440, 0.385551631, & + 5.02163824E-03, 0.372386932, 6.09764457E-03, & + 0.273956627, 0.407586545, 1.59074634E-03,0.136133015,& + 0.399842113] + + print *, "Test exponential_distribution_pdf_cdp" + seed = 123987654 + call random_seed(seed, get) + scale = (0.3_dp, 1.6_dp) + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_pdf(x1, scale) + res(:, 2:5) = expon_pdf(x2, scale) + call check(all(abs(res - reshape(ans, [3,5])) < dptol), & + msg="exponential_distribution_pdf_cdp failed", warn=warn) + end subroutine test_expon_pdf_cdp + + subroutine test_expon_pdf_cqp + complex(qp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [0.386471182, 0.386471182,0.386471182, 2.79592816E-03,& + 4.01333207E-03, 0.317740440, 0.385551631, & + 5.02163824E-03, 0.372386932, 6.09764457E-03, & + 0.273956627, 0.407586545, 1.59074634E-03,0.136133015,& + 0.399842113] + + print *, "Test exponential_distribution_pdf_cqp" + seed = 123987654 + call random_seed(seed, get) + scale = (0.3_qp, 1.6_qp) + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_pdf(x1, scale) + res(:, 2:5) = expon_pdf(x2, scale) + call check(all(abs(res - reshape(ans, [3,5])) < qptol), & + msg="exponential_distribution_pdf_cqp failed", warn=warn) + end subroutine test_expon_pdf_cqp + + + subroutine test_expon_cdf_rsp + real(sp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [0.370481908, 0.370481908, 0.370481908, 0.993631542, & + 0.246292457, 0.497423291, 0.999946773, 0.995101511, & + 0.305115670, 0.932980001, 0.967154086, 0.777015686, & + 0.983209372, 8.37164521E-02, 0.275721848] + + print *, "Test exponential_distribution_cdf_rsp" + seed = 621957438 + call random_seed(seed, get) + + scale = 2.0_sp + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_cdf(x1, scale) + res(:, 2:5) = expon_cdf(x2, scale) + call check(all(abs(res - reshape(ans,[3,5])) < sptol), & + msg="exponential_distribution_cdf_rsp failed", warn=warn) + end subroutine test_expon_cdf_rsp + + subroutine test_expon_cdf_rdp + real(dp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [0.370481908, 0.370481908, 0.370481908, 0.993631542, & + 0.246292457, 0.497423291, 0.999946773, 0.995101511, & + 0.305115670, 0.932980001, 0.967154086, 0.777015686, & + 0.983209372, 8.37164521E-02, 0.275721848] + + print *, "Test exponential_distribution_cdf_rdp" + seed = 621957438 + call random_seed(seed, get) + + scale = 2.0_dp + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_cdf(x1, scale) + res(:, 2:5) = expon_cdf(x2, scale) + call check(all(abs(res - reshape(ans,[3,5])) < dptol), & + msg="exponential_distribution_cdf_rdp failed", warn=warn) + end subroutine test_expon_cdf_rdp + + subroutine test_expon_cdf_rqp + real(qp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [0.370481908, 0.370481908, 0.370481908, 0.993631542, & + 0.246292457, 0.497423291, 0.999946773, 0.995101511, & + 0.305115670, 0.932980001, 0.967154086, 0.777015686, & + 0.983209372, 8.37164521E-02, 0.275721848] + + print *, "Test exponential_distribution_cdf_rqp" + seed = 621957438 + call random_seed(seed, get) + + scale = 2.0_qp + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_cdf(x1, scale) + res(:, 2:5) = expon_cdf(x2, scale) + call check(all(abs(res - reshape(ans,[3,5])) < qptol), & + msg="exponential_distribution_cdf_rqp failed", warn=warn) + end subroutine test_expon_cdf_rqp + + subroutine test_expon_cdf_csp + complex(sp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [0.176930442,0.176930442,0.176930442, 5.98644949E-02, & + 0.981560826,0.135309443,0.617795825, 7.55468607E-02, & + 0.118341736, 0.484595388, 0.794088185, 0.912919402, & + 0.914170802, 0.370377690, 0.793968201] + + print *, "Test exponential_distribution_cdf_csp" + seed = 621957438 + call random_seed(seed, get) + + scale = (1.3_sp, 2.1_sp) + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_cdf(x1, scale) + res(:, 2:5) = expon_cdf(x2, scale) + call check(all(abs(res - reshape(ans,[3,5])) < sptol), & + msg="exponential_distribution_cdf_csp failed", warn=warn) + end subroutine test_expon_cdf_csp + + subroutine test_expon_cdf_cdp + complex(dp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [0.176930442,0.176930442,0.176930442, 5.98644949E-02, & + 0.981560826,0.135309443,0.617795825, 7.55468607E-02, & + 0.118341736, 0.484595388, 0.794088185, 0.912919402, & + 0.914170802, 0.370377690, 0.793968201] + + print *, "Test exponential_distribution_cdf_cdp" + seed = 621957438 + call random_seed(seed, get) + + scale = (1.3_dp, 2.1_dp) + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_cdf(x1, scale) + res(:, 2:5) = expon_cdf(x2, scale) + call check(all(abs(res - reshape(ans,[3,5])) < dptol), & + msg="exponential_distribution_cdf_cdp failed", warn=warn) + end subroutine test_expon_cdf_cdp + + subroutine test_expon_cdf_cqp + complex(qp) :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real :: res(3,5) + real :: ans(15) = [0.176930442,0.176930442,0.176930442, 5.98644949E-02, & + 0.981560826,0.135309443,0.617795825, 7.55468607E-02, & + 0.118341736, 0.484595388, 0.794088185, 0.912919402, & + 0.914170802, 0.370377690, 0.793968201] + + print *, "Test exponential_distribution_cdf_cqp" + seed = 621957438 + call random_seed(seed, get) + + scale = (1.3_qp, 2.1_qp) + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_cdf(x1, scale) + res(:, 2:5) = expon_cdf(x2, scale) + call check(all(abs(res - reshape(ans,[3,5])) < qptol), & + msg="exponential_distribution_cdf_cqp failed", warn=warn) + end subroutine test_expon_cdf_cqp + +end program test_distribution_expon \ No newline at end of file From be5db330e38e52d259192971f23c6de3abedc895 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 16:34:57 -0500 Subject: [PATCH 03/55] initial commit --- .../stdlib_stats_distribution_exponential.md | 230 ++++++++++++++++++ 1 file changed, 230 insertions(+) create mode 100644 doc/specs/stdlib_stats_distribution_exponential.md diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md new file mode 100644 index 000000000..6510ebfc9 --- /dev/null +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -0,0 +1,230 @@ +--- +title: stats_distribution +--- + +# Statistical Distributions -- Exponential Module + +[TOC] + +## `exponential_distribution_rvs` - exponential distribution random variates + +### Status + +Experimental + +### Description + +An exponentially distributed random variate distribution is the distribution of time between events in a Poisson point process. The inverse scale parameter `lamda` specifies the rate of change. + +Without augument the function returns a standard exponential distributed random variate with `lamda = 1.0`. The function is elemental. + +With single argument, the function returns an exponential distributed random variate E(lamda). The function is elemental. For complex auguments, the real and imaginary parts are independent of each other. + +With two auguments the function returns a rank one array of random variates. + +### Syntax + +`result = [[stdlib_stats_distribution_expon(module):exponential_distribution_rvs(interface)]]([lamda] [[, array_size]])` + +### Arguments + +`lamda`: optional argument has `intent(in)` and is a scalar of type `real` or `complx`. + +`array_size`: optional argument has `intent(in)` and is a scalar of type `integer`. + +### Return value + +The result is a scalar or rank one array, with a size of `array_size`, of type `real` or `complx`. + +### Example + +```fortran +program demo_exponential_rvs + use stdlib_stats_distribution_PRNG, only : random_seed + use stdlib_stats_distribution_expon, only: & + rexp => exponential_distribution_rvs + + implicit none + real :: a(2,3,4) + complx :: scale + integer :: seed_put, seed_get + + seed_put = 1234567 + call random_seed(seed_put, seed_get) + + print *, rexp( ) !single standard exponential random variate + +! 0.358690143 + + print *, rexp(2.0) !exponential random variate with lamda=2.0 + +! 0.816459715 + + print *, rexp(0.3, 10) !an array of 10 variates with lamda=0.3 + +! [1.84008647E-02, 3.59742008E-02, 0.136567295, 0.262772143, 3.62352766E-02, +! 0.547133625, 0.213591918, 4.10784185E-02, 0.583882213, 0.671128035] + + a(:,:,:) = 0.5 + print *, rexp(a) !a rank 3 array of 24 exponential random variates + +! [0.219550118, 0.318272740, 0.426896989, 0.803026378, 0.395067871, +! 5.93891777E-02, 0.809226036, 1.27890170, 1.38805652, 0.179149821, +! 1.75288841E-02, 7.23171830E-02, 0.157068044, 0.153069839, 0.421180248, +! 0.517792642, 2.09411430, 0.785641313, 0.116311245, 0.295113146, +! 0.824005902, 0.123385273, 5.50238751E-02, 3.52851897E-02] + + scale = (2.0, 0.7) + print *, rexp(scale) !single complex exponential random variate with real part of lamda=2.0; imagainary part of lamda=0.7 + +! (1.41435969,4.081114382E-02) + +end program demo_exponential_rvs +``` + +## `exponential_distribution_pdf` - exponential probability density function + +### Status + +Experimental + +### Description + +The probability density function of the continuous exponential distribution. + +$$ f(x)=\begin{cases}lamda \times e^{-lamda \times x} &x\geqslant 0 \\\\ 0 &x< 0\end{} $$ + +### Syntax + +`result = [[stdlib_stats_distribution_expon(module):exponential_distribution_pdf(interface)]](x, lamda)` + +### Arguments + +`x`: has `intent(in)` and is a scalar of type `real` or `complx`. + +`lamda`: has `intent(in)` and is a scalar of type `real` or `complx`. + +The function is elemental, i.e., all auguments could be arrays conformable to each other. All arguments must have the same type. + +### Return value + +The result is a scalar or an array, with a shape conformable to auguments, of type `real`. + +### Example + +```fortran +program demo_exponential_pdf + use stdlib_stats_distribution_PRNG, only : random_seed + use stdlib_stats_distribution_expon, only : & + exp_pdf => exponential_distribution_pdf, & + rexp => exponential_distribution_rvs + + implicit none + real :: x(2,3,4),a(2,3,4) + complx :: scale + integer :: seed_put, seed_get + + seed_put = 1234567 + call random_seed(seed_put, seed_get) + + print *, exp_pdf(1.0,1.0) !a probability density at 1.0 in standard expon + +! 0.367879450 + + print *, exp_pdf(2.0,2.0) !a probability density at 2.0 with lamda=2.0 + +! 3.66312787E-02 + + x = reshape(rexp(0.5, 24),[2,3,4]) ! standard expon random variates array + a(:,:,:) = 0.5 + print *, exp_pdf(x, a) ! a rank 3 standard expon probability density + +! [0.457115263, 0.451488823, 0.492391467, 0.485233188, 0.446215510, +! 0.401670188, 0.485127628, 0.316924453, 0.418474048, 0.483173639, +! 0.307366133, 0.285812140, 0.448017836, 0.426440030, 0.403896868, +! 0.334653258, 0.410376132, 0.485370994, 0.333617479, 0.263791025, +! 0.249779820, 0.457159877, 0.495636940, 0.482243657] + + scale = (1.0, 2.) + print *, exp_pdf((1.5,1.0), scale) + ! a complex expon probability density function at (1.5,1.0) with real part of lamda=1.0 and imaginary part of lamda=2.0 + +! 6.03947677E-02 + +end program demo_exponential_pdf +``` + +## `exponential_distribution_cdf` - exponential cumulative distribution function + +### Status + +Experimental + +### Description + +Cumulative distribution function of the exponential continuous distribution + +$$ F(x)=\begin{cases}1 - e^{-lamda \times x} &x\geqslant 0 \\\\ 0 &x< 0\end{} $$ + + +### Syntax + +`result = [[stdlib_stats_distribution_expon(module):exponential_distribution_cdf(interface)]](x, lamda)` + +### Arguments + +`x`: has `intent(in)` and is a scalar of type `real` or `complx`. + +`lamda`: has `intent(in)` and is a scalar of type `real` or `complx`. + +The function is elemental, i.e., all auguments could be arrays conformable to each other. All arguments must have the same type. + +### Return value + +The result is a scalar or an array, with a shape conformable to auguments, of type `real`. + +### Example + +```fortran +program demo_exponential_cdf + use stdlib_stats_distribution_PRNG, only : random_seed + use stdlib_stats_distribution_expon, only : & + exp_cdf => exponential_distribution_cdf, & + rexp => exponential_distribution_rvs + + implicit none + real :: x(2,3,4),a(2,3,4) + complx :: scale + integer :: seed_put, seed_get + + seed_put = 1234567 + call random_seed(seed_put, seed_get) + + print *, exp_cdf(1.0, 1.0) ! a standard exponential cumulative at 1.0 + +! 0.632120550 + + print *, exp_cdf(2.0, 2.0) ! a cumulative at 2.0 with lamda=2 + +! 0.981684387 + + x = reshape(rexp(0.5, 24),[2,3,4]) + ! standard exponential random variates array + a(:,:,:) = 0.5 + print *, exp_cdf(x, a) ! a rank 3 array of standard exponential cumulative + +! [8.57694745E-02, 9.70223546E-02, 1.52170658E-02, 2.95336246E-02, +! 0.107568979, 0.196659625, 2.97447443E-02, 0.366151094, 0.163051903, +! 3.36527228E-02, 0.385267735, 0.428375721, 0.103964329, 0.147119939, +! 0.192206264, 0.330693483, 0.179247737, 2.92580128E-02, 0.332765043, +! 0.472417951, 0.500440359, 8.56802464E-02, 8.72612000E-03, 3.55126858E-02] + + scale = (0.5,1.0) + print *, exp_cdf((0.5,0.5),scale) + !complex exponential cumulative distribution at (0.5,0.5) with real part of lamda=0.5 and imaginary part of lamda=1.0 + +! 8.70351046E-02 + +end program demo_exponential_cdf + +``` From 68d99eedff5339df90c440dec4ed305cfa6ad6aa Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 16:36:16 -0500 Subject: [PATCH 04/55] initial commit --- src/CMakeLists.txt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 33144ad07..e9414febd 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -20,7 +20,8 @@ set(fppFiles stdlib_quadrature_simps.fypp stdlib_stats_distribution_PRNG.fypp stdlib_stats_distribution_uniform.fypp - stdlib_stats_distribution_normal.fypp + stdlib_stats_distribution_normal.fypp + stdlib_stats_distribution_exponential.fypp ) From cef48debcc409de8e943e8404d5ee295d02ce6e2 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 16:40:37 -0500 Subject: [PATCH 05/55] Update Makefile.manual --- src/Makefile.manual | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 725b4aec9..7c66a52d2 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -18,7 +18,8 @@ SRC = f18estop.f90 \ stdlib_stats_var.f90 \ stdlib_stats_distribution_PRNG.f90\ stdlib_stats_distribution_uniform.f90 \ - stdlib_stats_distribution_normal.f90 + stdlib_stats_distribution_normal.f90 \ + stdlib_stats_distribution_exponential.f90 LIB = libstdlib.a @@ -72,15 +73,20 @@ stdlib_stats_var.o: \ stdlib_stats.o stdlib_stats_distribution_PRNG.o: stdlib_kinds.o stdlib_stats_distribution_uniform.o: \ - stdlib_kinds.o \ + stdlib_kinds.o \ stdlib_error.o \ stdlib_stats_distribution_PRNG.o stdlib_stats_distribution_normal.o \ - stdlib_kinds.o + stdlib_kinds.o stdlib_error.o \ stdlib_stats_distribution.PRNG.o \ stdlib_stats_distribution.uniform.o - +stdlib_stats_distribution_exponential.o \ + stdlib_kinds.o \ + stdlib_error.o \ + stdlib_stats_distribtuion_PRNG.o \ + stdlib_stats_distribution_uniform.o + # Fortran sources that are built from fypp templates stdlib_bitsets_64.f90: stdlib_bitsets_64.fypp stdlib_bitsets_large.f90: stdlib_bitsets_large.fypp @@ -95,4 +101,5 @@ stdlib_stats_moment.f90: stdlib_stats_moment.fypp stdlib_stats_var.f90: stdlib_stats_var.fypp stdlib_stats_distribution_PRNG.f90: stdlib_stats_distribution_PRNG.fypp stdlib_stats_distribution_uniform.f90: stdlib_stats_distribution_uniform.fypp -stdlib_stats_distribution_normal.f90: stdlib_stats_distribution_normal.fypp \ No newline at end of file +stdlib_stats_distribution_normal.f90: stdlib_stats_distribution_normal.fypp +stdlib_stats_distribution_exponential.f90: stdlib_stats_distribution.exponential.fypp From 5b4b09b0569280c199d8d6399577d3ee700c1a14 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 16:41:29 -0500 Subject: [PATCH 06/55] Update CMakeLists.txt --- src/tests/stats/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/stats/CMakeLists.txt b/src/tests/stats/CMakeLists.txt index 3fbf70055..7645158d3 100644 --- a/src/tests/stats/CMakeLists.txt +++ b/src/tests/stats/CMakeLists.txt @@ -5,7 +5,7 @@ ADDTEST(moment) ADDTEST(rawmoment) ADDTEST(var) ADDTEST(varn) -ADDTEST(distribution_normal) +ADDTEST(distribution_exponential) if(DEFINED CMAKE_MAXIMUM_RANK) if(${CMAKE_MAXIMUM_RANK} GREATER 7) From f1a3de20d16f93467328511e53ee07eeac075f66 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 16:41:55 -0500 Subject: [PATCH 07/55] Update Makefile.manual --- src/tests/stats/Makefile.manual | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tests/stats/Makefile.manual b/src/tests/stats/Makefile.manual index 9a82079e0..d9d828876 100644 --- a/src/tests/stats/Makefile.manual +++ b/src/tests/stats/Makefile.manual @@ -1,5 +1,5 @@ PROGS_SRC = test_mean.f90 test_moment.f90 test_var.f90 \ - test_distribution_normal.f90 + test_distribution_exponential.f90 -include ../Makefile.manual.test.mk \ No newline at end of file +include ../Makefile.manual.test.mk From ae699545004b41dbcaea73717494f69e53d98bb6 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 16:43:21 -0500 Subject: [PATCH 08/55] Update index.md --- doc/specs/index.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/index.md b/doc/specs/index.md index a827b392c..e136487e1 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -20,7 +20,7 @@ This is and index/directory of the specifications (specs) for each new module/fe - [stats_distribution_PRNG](./stdlib_stats_distribution_PRNG.html) - Probability Distributions random number generator - [stats_distribution_uniform](./stdlib_stats_distribution_uniform.html) - Uniform probability distribution - [stats_distribution_normal](./stdlib_stats_distribution_normal.html) - Normal probability distribution - + - [stats_distribution_exponential](./stdlib_stats_distribution_exponential.html) - Exponential probability distribution ## Missing specs From 8bdaa8c8d39181ef3aac8d381b67bfda54026df0 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 16:45:53 -0500 Subject: [PATCH 09/55] Delete stdlib_stats_distribution_normal.md --- doc/specs/stdlib_stats_distribution_normal.md | 248 ------------------ 1 file changed, 248 deletions(-) delete mode 100644 doc/specs/stdlib_stats_distribution_normal.md diff --git a/doc/specs/stdlib_stats_distribution_normal.md b/doc/specs/stdlib_stats_distribution_normal.md deleted file mode 100644 index e07c0cbb1..000000000 --- a/doc/specs/stdlib_stats_distribution_normal.md +++ /dev/null @@ -1,248 +0,0 @@ ---- -title: stats_distribution ---- - -# Statistical Distributions Normal Module - -[TOC] - -## `normal_distribution_rvs` - normal distribution random variates - -### Status - -Experimental - -### Description - -A normal continuous random variate distribution, also known as Gaussian, or Gauss or Laplace-Gauss distribution. The location `loc` specifies the mean or expectation. The `scale` specifies the standard deviation. - -Without augument the function returns a standard normal distributed random variate N(0,1). The function is elemental. - -With two arguments, the function returns a normal distributed random variate N(loc, scale^2). For complex auguments, the real and imaginary parts are independent of each other. The function is elemental. - -With three auguments, the function returns a rank one array of normal distributed random variates. - -### Syntax - -`result = [[stdlib_stats_distribution_normal(module):normal_distribution_rvs(interface)]]([loc, scale] [[, array_size]])` - -### Arguments - -`array_size`: optional argument has `intent(in)` and is a scalar of type `integer`. - -`loc`: optional argument has `intent(in)` and is a scalar of type `real` or `complx`. - -`scale`: optional argument has `intent(in)` and is a scalar of type `real` or `complx`. - -`loc` and `scale` arguments must have the same type. - -### Return value - -The result is a scalar or rank one array, with a size of `array_size`, of type `real` or `complx`. - -### Example - -```fortran -program demo_normal_rvs - use stdlib_stats_distribution_normal, only: norm => normal_distribution_rvs - use stdlib_stats_distribution_PRNG, only: random_seed - implicit none - real :: a(2,3,4), b(2,3,4) - complx :: loc, scale - integer :: seed_put, seed_get - - seed_put = 1234567 - call random_seed(seed_put, seed_get) - - print *, norm( ) !single standard normal random variate - -! 0.563655198 - - print *, norm(1.0, 2.0) - !normal random variate miu=1.0, sigma=2.0 - -! -0.633261681 - - print *, norm(0.,1.0,10) !an array of 10 standard norml random variates - -! [-3.38123664E-02, -0.190365672, 0.220678389, -0.424612164, -0.249541596, -! 0.865260184, 1.11086845, -0.328349441, 1.10873628, 1.27049923] - - a(:,:,:) = 1.0 - b(:,:,:) = 1.0 - print *, norm(a,b) ! a rank 3 random variates array - -![0.152776539, -7.51764774E-02, 1.47208166, 0.180561781, 1.32407105, -! 1.20383692, 0.123445868, -0.455737948, -0.469808221, 1.60750175, -! 1.05748117, 0.720934749, 0.407810807, 1.48165631, 2.31749439, -! 0.414566994, 3.06084275, 1.86505437, 1.36338580, 7.26878643E-02, -! 0.178585172, 1.39557445, 0.828021586, 0.872084975] - - loc = (-1.0, 2.0) - scale = (2.0, 1.0) - print *, norm(loc, scale) - !single complex normal random variate with real part of mu=-1, sigma=2; imagainary part of mu=2.0 and sigma=1.0 - -! (1.22566295,2.12518454) - -end program demo_normal_rvs -``` - -## `normal_distribution_pdf` - normal probability density function - -### Status - -Experimental - -### Description - -The probability density function of the continuous normal distribution. - -$$f(x)=\frac{1}{\sigma&space;\sqrt{2&space;\pi}}&space;e^{-\frac{1}{2}(\frac{x-\mu}{\sigma})^{2}})$$ - -### Syntax - -`result = [[stdlib_stats_distribution_normal(module):normal_distribution_pdf(interface)]](x, loc, scale)` - -### Arguments - -`x`: has `intent(in)` and is a scalar of type `real` or `complx`. - -`loc`: has `intent(in)` and is a scalar of type `real` or `complx`. - -`scale`: has `intent(in)` and is a scalar of type `real` or `complx`. - -The function is elemental, i.e., all three auguments could be arrays conformable to each other. All three arguments must have the same type. - -### Return value - -The result is a scalar or an array, with a shape conformable to auguments, of type `real`. - -### Example - -```fortran -program demo_normal_pdf - use stdlib_stats_distribution_PRNG, only : random_seed - use stdlib_stats_distribution_normal, only : & - norm_pdf=>normal_distribution_pdf,& - norm => normal_distribution_rvs - - implicit none - real :: x(2,3,4),a(2,3,4),b(2,3,4) - complx :: loc, scale - integer :: seed_put, seed_get - - seed_put = 1234567 - call random_seed(seed_put, seed_get) - - print *, norm_pdf(1.0,0.,1.) !a probability density at 1.0 in standard normal - -! 0.241970733 - - print *, norm_pdf(2.0,-1.0, 2.0) - !a probability density at 2.0 with mu=-1.0 sigma=2.0 - -!6.47588000E-02 - - x = reshape(norm(0.0, 1.0, 24),[2,3,4]) - ! standard normal random variates array - - a(:,:,:) = 0.0 - b(:,:,:) = 1.0 - print *, norm_pdf(x, a, b) ! standard normal probability density array - -! [0.340346158, 0.285823315, 0.398714304, 0.391778737, 0.389345556, -! 0.364551932, 0.386712372, 0.274370432, 0.215250477, 0.378006011, -! 0.215760440, 0.177990928, 0.278640658, 0.223813817, 0.356875211, -! 0.285167664, 0.378533930, 0.390739858, 0.271684974, 0.138273031, -! 0.135456234, 0.331718773, 0.398283750, 0.383706540] - - loc = (1.0, -0.5) - scale = (1.0, 2.) - print *, norm_pdf((1.5,1.0), loc, scale) - ! a complex normal probability density function at (1.5,1.0) with real part of mu=1.0, sigma=1.0 and imaginary part of mu=-0.5, sigma=2.0 - -! 5.30100204E-02 - -end program demo_normal_pdf -``` - -## `normal_distribution_cdf` - normal cumulative distribution function - -### Status - -Experimental - -### Description - -Cumulative distribution function of the normal continuous distribution - -$$F(X)=\frac{1}{2}\left&space;[&space;1&space;+&space;erf(\frac{x-\mu}{\sqrt{2}&space;\sigma})&space;\right&space;])$$ - -### Syntax - -`result = [[stdlib_stats_distribution_normal(module):normal_distribution_cdf(interface)]](x, loc, scale)` - -### Arguments - -`x`: has `intent(in)` and is a scalar of type `real` or `complx`. - -`loc`: has `intent(in)` and is a scalar of type `real` or `complx`. - -`scale`: has `intent(in)` and is a scalar of type `real` or `complx`. - -The function is elemental, i.e., all three auguments could be arrays conformable to each other. All three arguments must have the same type. - -### Return value - -The result is a scalar or an array, with a shape conformable to auguments, of type `real`. - -### Example - -```fortran -program demo_norm_cdf - use stdlib_stats_distribution_PRNG, only : random_seed - use stdlib_stats_distribution_normal, only : & - norm_cdf => normal_distribution_cdf, & - norm => normal_distribution_rvs - - implicit none - real :: x(2,3,4),a(2,3,4),b(2,3,4) - complx :: loc, scale - integer :: seed_put, seed_get - - seed_put = 1234567 - call random_seed(seed_put, seed_get) - - print *, norm_cdf(1.0, 0.0, 1.0) ! a standard normal cumulative at 1.0 - -! 0.841344714 - - print *, norm_cdf(2.0, -1.0, 2.0) - ! a cumulative at 2.0 with mu=-1 sigma=2 - -! 0.933192849 - - x = reshape(norm(0.0, 1.0, 24),[2,3,4]) - ! standard normal random variates array - - a(:,:,:) = 0.0 - b(:,:,:) = 1.0 - print *, norm_cdf(x, a, b) ! standard normal cumulative array - -! [0.713505626, 0.207069695, 0.486513376, 0.424511284, 0.587328553, -! 0.335559726, 0.401470929, 0.806552052, 0.866687536, 0.371323735, -! 0.866228044, 0.898046613, 0.198435277, 0.141147852, 0.681565762, -! 0.206268221, 0.627057910, 0.580759525, 0.190364420, 7.27325380E-02, -! 7.08068311E-02, 0.728241026, 0.522919059, 0.390097380] - - loc = (1.0,0.0) - scale = (0.5,1.0) - print *, norm_cdf((0.5,-0.5),loc,scale) - !complex normal cumulative distribution at (0.5,-0.5) with real part of mu=1.0, sigma=0.5 and imaginary part of mu=0.0, sigma=1.0 - -!4.89511043E-02 - -end program demo_norm_cdf - -``` From bd5b66fa4fa07fcf447dc7ed50d4ce453c4db1a6 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 19:16:22 -0500 Subject: [PATCH 10/55] Update Makefile.manual --- src/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 7c66a52d2..9096261e7 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -16,7 +16,7 @@ SRC = f18estop.f90 \ stdlib_stats_mean.f90 \ stdlib_stats_moment.f90 \ stdlib_stats_var.f90 \ - stdlib_stats_distribution_PRNG.f90\ + stdlib_stats_distribution_PRNG.f90 \ stdlib_stats_distribution_uniform.f90 \ stdlib_stats_distribution_normal.f90 \ stdlib_stats_distribution_exponential.f90 From 85848fcdf305eeaf8b057b57fcb58e1c7a97990c Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 19:22:13 -0500 Subject: [PATCH 11/55] Add files via upload --- CMakeLists.txt | 110 +++++++++++++++++++++--------------------------- Makefile.manual | 108 ++++++++--------------------------------------- 2 files changed, 64 insertions(+), 154 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 33144ad07..d62689913 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,70 +1,54 @@ -### Pre-process: .fpp -> .f90 via Fypp - -# Create a list of the files to be preprocessed -set(fppFiles - stdlib_bitsets.fypp - stdlib_bitsets_64.fypp - stdlib_bitsets_large.fypp - stdlib_io.fypp - stdlib_linalg.fypp - stdlib_linalg_diag.fypp - stdlib_optval.fypp - stdlib_stats.fypp - stdlib_stats_corr.fypp - stdlib_stats_cov.fypp - stdlib_stats_mean.fypp - stdlib_stats_moment.fypp - stdlib_stats_var.fypp - stdlib_quadrature.fypp - stdlib_quadrature_trapz.fypp - stdlib_quadrature_simps.fypp - stdlib_stats_distribution_PRNG.fypp - stdlib_stats_distribution_uniform.fypp - stdlib_stats_distribution_normal.fypp -) +cmake_minimum_required(VERSION 3.14.0) +project(stdlib Fortran) +enable_testing() + +include(${CMAKE_SOURCE_DIR}/cmake/stdlib.cmake) + +# --- compiler options +if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) + add_compile_options(-fimplicit-none) + add_compile_options(-ffree-line-length-132) + add_compile_options(-Wall) + add_compile_options(-Wextra) + add_compile_options(-Wimplicit-procedure) + add_compile_options(-Wconversion-extra) + # -pedantic-errors triggers a false positive for optional arguments of elemental functions, + # see test_optval and https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95446 + add_compile_options(-pedantic-errors) + if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 8.0) + add_compile_options(-std=f2018) + else() + add_compile_options(-std=f2008ts) + endif() +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL Intel) + add_compile_options(-warn declarations,general,usage,interfaces,unused) + if(NOT CMAKE_Fortran_COMPILER_VERSION VERSION_EQUAL 20.2.1.20200827) + add_compile_options(-standard-semantics) + endif() + if(CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 18.0) + add_compile_options(-stand f15) + else() + add_compile_options(-stand f18) + endif() +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL PGI) + add_compile_options(-Mdclchk) +endif() +# --- compiler feature checks +include(CheckFortranSourceCompiles) +include(CheckFortranSourceRuns) +check_fortran_source_runs("i=0; error stop i; end" f18errorstop SRC_EXT f90) +check_fortran_source_compiles("real, allocatable :: array(:, :, :, :, :, :, :, :, :, :); end" f03rank SRC_EXT f90) +check_fortran_source_runs("use, intrinsic :: iso_fortran_env, only : real128; real(real128) :: x; x = x+1; end" f03real128) -# Custom preprocessor flags if(DEFINED CMAKE_MAXIMUM_RANK) - set(fyppFlags "-DMAXRANK=${CMAKE_MAXIMUM_RANK}") -elseif(f03rank) - set(fyppFlags) -else() - set(fyppFlags "-DVERSION90") + set(CMAKE_MAXIMUM_RANK ${CMAKE_MAXIMUM_RANK}) endif() -fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) - -set(SRC - stdlib_ascii.f90 - stdlib_error.f90 - stdlib_kinds.f90 - stdlib_logger.f90 - stdlib_system.F90 - ${outFiles} -) - -add_library(fortran_stdlib ${SRC}) - -set(LIB_MOD_DIR ${CMAKE_CURRENT_BINARY_DIR}/mod_files/) -set_target_properties(fortran_stdlib PROPERTIES - Fortran_MODULE_DIRECTORY ${LIB_MOD_DIR}) -target_include_directories(fortran_stdlib PUBLIC - $ - $ -) - -if(f18errorstop) - target_sources(fortran_stdlib PRIVATE f18estop.f90) -else() - target_sources(fortran_stdlib PRIVATE f08estop.f90) +# --- find preprocessor +find_program(FYPP fypp) +if(NOT FYPP) + message(FATAL_ERROR "Preprocessor fypp not found!") endif() -add_subdirectory(tests) - -install(TARGETS fortran_stdlib - RUNTIME DESTINATION bin - ARCHIVE DESTINATION lib - LIBRARY DESTINATION lib - ) -install(DIRECTORY ${LIB_MOD_DIR} DESTINATION include) +add_subdirectory(src) diff --git a/Makefile.manual b/Makefile.manual index 725b4aec9..b8280b102 100644 --- a/Makefile.manual +++ b/Makefile.manual @@ -1,98 +1,24 @@ -SRC = f18estop.f90 \ - stdlib_ascii.f90 \ - stdlib_bitsets.f90 \ - stdlib_bitsets_64.f90 \ - stdlib_bitsets_large.f90 \ - stdlib_error.f90 \ - stdlib_io.f90 \ - stdlib_kinds.f90 \ - stdlib_linalg.f90 \ - stdlib_linalg_diag.f90 \ - stdlib_logger.f90 \ - stdlib_optval.f90 \ - stdlib_quadrature.f90 \ - stdlib_quadrature_trapz.f90 \ - stdlib_stats.f90 \ - stdlib_stats_mean.f90 \ - stdlib_stats_moment.f90 \ - stdlib_stats_var.f90 \ - stdlib_stats_distribution_PRNG.f90\ - stdlib_stats_distribution_uniform.f90 \ - stdlib_stats_distribution_normal.f90 - -LIB = libstdlib.a +# Fortran stdlib Makefile +FC = gfortran +FFLAGS = -Wall -Wextra -Wimplicit-interface -fPIC -g -fcheck=all +FYPPFLAGS= +export FC +export FFLAGS +export FYPPFLAGS -OBJS = $(SRC:.f90=.o) -MODS = $(OBJS:.o=.mod) -SMODS = $(OBJS:.o=*.smod) +.PHONY: all clean test -.PHONY: all clean +all: + $(MAKE) -f Makefile.manual --directory=src + $(MAKE) -f Makefile.manual --directory=src/tests -all: $(LIB) - -$(LIB): $(OBJS) - ar rcs $@ $(OBJS) +test: + $(MAKE) -f Makefile.manual --directory=src/tests test + @echo + @echo "All tests passed." clean: - $(RM) $(LIB) $(OBJS) $(MODS) $(SMODS) - -%.o: %.f90 - $(FC) $(FFLAGS) -c $< - -%.f90: %.fypp - fypp $(FYPPFLAGS) $< $@ - -# Fortran module dependencies -f18estop.o: stdlib_error.o -stdlib_bitsets.o: stdlib_kinds.o -stdlib_bitsets_64.o: stdlib_bitsets.o -stdlib_bitsets_large.o: stdlib_bitsets.o -stdlib_error.o: stdlib_optval.o -stdlib_io.o: \ - stdlib_error.o \ - stdlib_optval.o \ - stdlib_kinds.o -stdlib_linalg_diag.o: stdlib_kinds.o -stdlib_logger.o: stdlib_ascii.o stdlib_optval.o -stdlib_optval.o: stdlib_kinds.o -stdlib_quadrature.o: stdlib_kinds.o -stdlib_stats_mean.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o -stdlib_stats_moment.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o -stdlib_stats_var.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o -stdlib_stats_distribution_PRNG.o: stdlib_kinds.o -stdlib_stats_distribution_uniform.o: \ - stdlib_kinds.o \ - stdlib_error.o \ - stdlib_stats_distribution_PRNG.o -stdlib_stats_distribution_normal.o \ - stdlib_kinds.o - stdlib_error.o \ - stdlib_stats_distribution.PRNG.o \ - stdlib_stats_distribution.uniform.o - -# Fortran sources that are built from fypp templates -stdlib_bitsets_64.f90: stdlib_bitsets_64.fypp -stdlib_bitsets_large.f90: stdlib_bitsets_large.fypp -stdlib_bitsets.f90: stdlib_bitsets.fypp -stdlib_io.f90: stdlib_io.fypp -stdlib_linalg.f90: stdlib_linalg.fypp -stdlib_linalg_diag.f90: stdlib_linalg_diag.fypp -stdlib_quadrature.f90: stdlib_quadrature.fypp -stdlib_stats.f90: stdlib_stats.fypp -stdlib_stats_mean.f90: stdlib_stats_mean.fypp -stdlib_stats_moment.f90: stdlib_stats_moment.fypp -stdlib_stats_var.f90: stdlib_stats_var.fypp -stdlib_stats_distribution_PRNG.f90: stdlib_stats_distribution_PRNG.fypp -stdlib_stats_distribution_uniform.f90: stdlib_stats_distribution_uniform.fypp -stdlib_stats_distribution_normal.f90: stdlib_stats_distribution_normal.fypp \ No newline at end of file + $(MAKE) -f Makefile.manual clean --directory=src + $(MAKE) -f Makefile.manual clean --directory=src/tests From c4ef626eef9791220dd8bd7ce4ac081530c8bbf1 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 19:28:15 -0500 Subject: [PATCH 12/55] Update Makefile.manual --- src/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 9096261e7..62a1cdda8 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -77,7 +77,7 @@ stdlib_stats_distribution_uniform.o: \ stdlib_error.o \ stdlib_stats_distribution_PRNG.o stdlib_stats_distribution_normal.o \ - stdlib_kinds.o + stdlib_kinds.o \ stdlib_error.o \ stdlib_stats_distribution.PRNG.o \ stdlib_stats_distribution.uniform.o From 07b111319eee5b1fd4f576a3b92d136d4b80ce4a Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 19:40:50 -0500 Subject: [PATCH 13/55] Update Makefile.manual --- src/Makefile.manual | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 62a1cdda8..8f4d3420a 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -76,12 +76,12 @@ stdlib_stats_distribution_uniform.o: \ stdlib_kinds.o \ stdlib_error.o \ stdlib_stats_distribution_PRNG.o -stdlib_stats_distribution_normal.o \ +stdlib_stats_distribution_normal.o: \ stdlib_kinds.o \ stdlib_error.o \ stdlib_stats_distribution.PRNG.o \ stdlib_stats_distribution.uniform.o -stdlib_stats_distribution_exponential.o \ +stdlib_stats_distribution_exponential.o: \ stdlib_kinds.o \ stdlib_error.o \ stdlib_stats_distribtuion_PRNG.o \ From 292dfa93c68f7d13fdfd686f7532feb5af07b19e Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 19:57:33 -0500 Subject: [PATCH 14/55] Update Makefile.manual --- src/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 8f4d3420a..f97117568 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -102,4 +102,4 @@ stdlib_stats_var.f90: stdlib_stats_var.fypp stdlib_stats_distribution_PRNG.f90: stdlib_stats_distribution_PRNG.fypp stdlib_stats_distribution_uniform.f90: stdlib_stats_distribution_uniform.fypp stdlib_stats_distribution_normal.f90: stdlib_stats_distribution_normal.fypp -stdlib_stats_distribution_exponential.f90: stdlib_stats_distribution.exponential.fypp +stdlib_stats_distribution_exponential.f90: stdlib_stats_distribution_exponential.fypp From f72e19767a5c169903593369df529227d6f2f7f1 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 20:05:48 -0500 Subject: [PATCH 15/55] Update Makefile.manual --- src/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index f97117568..5676718ca 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -84,7 +84,7 @@ stdlib_stats_distribution_normal.o: \ stdlib_stats_distribution_exponential.o: \ stdlib_kinds.o \ stdlib_error.o \ - stdlib_stats_distribtuion_PRNG.o \ + stdlib_stats_distribution_PRNG.o \ stdlib_stats_distribution_uniform.o # Fortran sources that are built from fypp templates From 33333656baffd70d746982fdf0135737f960c7c7 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 20:06:16 -0500 Subject: [PATCH 16/55] Update stdlib_stats_distribution_normal.fypp --- src/stdlib_stats_distribution_normal.fypp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_stats_distribution_normal.fypp b/src/stdlib_stats_distribution_normal.fypp index de55412ab..da7abfc2f 100644 --- a/src/stdlib_stats_distribution_normal.fypp +++ b/src/stdlib_stats_distribution_normal.fypp @@ -25,7 +25,7 @@ Module stdlib_stats_distribution_normal !!([Specification](../page/specs/stdlib_stats_distribution_normal.html# !! description)) !! - module procedure norm_dist_rvs_0_rsp !0 dummy varaible + module procedure norm_dist_rvs_0_rsp !0 dummy variable #:for k1, t1 in RC_KINDS_TYPES module procedure norm_dist_rvs_${t1[0]}$${k1}$ !2 dummy variables @@ -363,4 +363,4 @@ Module stdlib_stats_distribution_normal #:endfor -end module stdlib_stats_distribution_normal \ No newline at end of file +end module stdlib_stats_distribution_normal From 4b429bd5cea6112028d2d5129fe1688f1f7a2e2e Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 20:10:12 -0500 Subject: [PATCH 17/55] Update Makefile.manual --- src/Makefile.manual | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 5676718ca..9bcdb86ba 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -79,8 +79,8 @@ stdlib_stats_distribution_uniform.o: \ stdlib_stats_distribution_normal.o: \ stdlib_kinds.o \ stdlib_error.o \ - stdlib_stats_distribution.PRNG.o \ - stdlib_stats_distribution.uniform.o + stdlib_stats_distribution_PRNG.o \ + stdlib_stats_distribution_uniform.o stdlib_stats_distribution_exponential.o: \ stdlib_kinds.o \ stdlib_error.o \ From 917fe96a7d9a784147c624f410933eb948a41329 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Mon, 21 Dec 2020 20:16:25 -0500 Subject: [PATCH 18/55] Update stdlib_stats_distribution_uniform.fypp --- src/stdlib_stats_distribution_uniform.fypp | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/stdlib_stats_distribution_uniform.fypp b/src/stdlib_stats_distribution_uniform.fypp index d092129ce..d51680f0f 100644 --- a/src/stdlib_stats_distribution_uniform.fypp +++ b/src/stdlib_stats_distribution_uniform.fypp @@ -185,7 +185,6 @@ Module stdlib_stats_distribution_uniform ! ${t1}$, intent(in) :: scale ${t1}$ :: res - integer(int64) :: tmp real(${k1}$) :: r1, r2, tr, ti if(scale == (0.0_${k1}$, 0.0_${k1}$)) call error_stop("Error: Uniform" & @@ -218,7 +217,6 @@ Module stdlib_stats_distribution_uniform ! ${t1}$, intent(in) :: loc, scale ${t1}$ :: res - integer(int64) :: tmp real(${k1}$) :: r1, r2, tr, ti if(scale == (0.0_${k1}$, 0.0_${k1}$)) call error_stop("Error: Uniform" & @@ -481,4 +479,4 @@ Module stdlib_stats_distribution_uniform end function shuffle_${t1[0]}$${k1}$ #:endfor -end module stdlib_stats_distribution_uniform \ No newline at end of file +end module stdlib_stats_distribution_uniform From a70b6d2f9c662eeaf21279fc3bcd5b9cb45c1a81 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Tue, 22 Dec 2020 10:00:39 -0500 Subject: [PATCH 19/55] Update stdlib_stats_distribution_exponential.md --- doc/specs/stdlib_stats_distribution_exponential.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md index 6510ebfc9..6c8ea4179 100644 --- a/doc/specs/stdlib_stats_distribution_exponential.md +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -2,7 +2,7 @@ title: stats_distribution --- -# Statistical Distributions -- Exponential Module +# Statistical Distributions -- Exponential Distribution Module [TOC] From 1a5ba93af40c477612e05be875cf1d5d8b75157e Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 27 Dec 2020 12:09:50 -0500 Subject: [PATCH 20/55] Delete stdlib_stats_distribution_normal.fypp --- src/stdlib_stats_distribution_normal.fypp | 366 ---------------------- 1 file changed, 366 deletions(-) delete mode 100644 src/stdlib_stats_distribution_normal.fypp diff --git a/src/stdlib_stats_distribution_normal.fypp b/src/stdlib_stats_distribution_normal.fypp deleted file mode 100644 index da7abfc2f..000000000 --- a/src/stdlib_stats_distribution_normal.fypp +++ /dev/null @@ -1,366 +0,0 @@ -#:include "common.fypp" -#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES -Module stdlib_stats_distribution_normal - use stdlib_kinds - use stdlib_error, only : error_stop - use stdlib_stats_distribution_PRNG, only : dist_rand - use stdlib_stats_distribution_uniform, only : uni=>uniform_distribution_rvs - - implicit none - private - - real(dp), parameter :: HALF = 0.5_dp, ONE = 1.0_dp, TWO = 2.0_dp - integer, save :: kn(0:127) - real(dp), save :: wn(0:127), fn(0:127) - logical, save :: zig_norm_initialized = .false. - - public :: normal_distribution_rvs - public :: normal_distribution_pdf - public :: normal_distribution_cdf - - interface normal_distribution_rvs - !! Version experimental - !! - !! Normal Distribution Random Variates - !!([Specification](../page/specs/stdlib_stats_distribution_normal.html# - !! description)) - !! - module procedure norm_dist_rvs_0_rsp !0 dummy variable - - #:for k1, t1 in RC_KINDS_TYPES - module procedure norm_dist_rvs_${t1[0]}$${k1}$ !2 dummy variables - #:endfor - - #:for k1, t1 in RC_KINDS_TYPES - module procedure norm_dist_rvs_array_${t1[0]}$${k1}$ !3 dummy variables - #:endfor - end interface normal_distribution_rvs - - interface normal_distribution_pdf - !! Version experimental - !! - !! Normal Distribution Probability Density Function - !!([Specification](../page/specs/stdlib_stats_distribution_normal.html# - !! description)) - !! - #:for k1, t1 in RC_KINDS_TYPES - module procedure norm_dist_pdf_${t1[0]}$${k1}$ - #:endfor - end interface normal_distribution_pdf - - interface normal_distribution_cdf - !! Version experimental - !! - !! Normal Distribution Cumulative Distribution Function - !!([Specification](../page/specs/stdlib_stats_distribution_normal.html# - !! description)) - !! - #:for k1, t1 in RC_KINDS_TYPES - module procedure norm_dist_cdf_${t1[0]}$${k1}$ - #:endfor - end interface normal_distribution_cdf - - - contains - - subroutine zigset - ! Marsaglia & Tsang generator for random normals & random exponentials. - ! Translated from C by Alan Miller (amiller@bigpond.net.au) - ! - ! Marsaglia, G. & Tsang, W.W. (2000) `The ziggurat method for generating - ! random variables', J. Statist. Software, v5(8). - ! - ! This is an electronic journal which can be downloaded from: - ! http://www.jstatsoft.org/v05/i08 - ! - ! N.B. It is assumed that all integers are 32-bit. - ! - ! Latest version - 1 January 2001 - ! - real(dp), parameter :: M1 = 2147483648.0_dp - real(dp) :: dn = 3.442619855899_dp, tn, & - vn = 0.00991256303526217_dp, q - integer :: i - - tn = dn - ! tables for random normals - q = vn * exp(HALF * dn * dn) - kn(0) = int((dn / q) * M1, kind = int32) - kn(1) = 0 - wn(0) = q / M1 - wn(127) = dn / M1 - fn(0) = ONE - fn(127) = exp( -HALF * dn * dn ) - do i = 126, 1, -1 - dn = sqrt( -TWO * log( vn / dn + exp( -HALF * dn * dn ) ) ) - kn(i+1) = int((dn / tn) * M1, kind = int32) - tn = dn - fn(i) = exp(-HALF * dn * dn) - wn(i) = dn / M1 - end do - zig_norm_initialized = .true. - return - end subroutine zigset - - #:for k1, t1 in REAL_KINDS_TYPES - impure elemental function norm_dist_rvs_0_${t1[0]}$${k1}$( ) result(res) - ! Standard normal random vairate (0,1) - ! - ${t1}$ :: res - ${t1}$, parameter :: r = 3.442619855899_${k1}$, rr = 1.0_${k1}$ / r - ${t1}$ :: x, y - integer :: hz, iz - - if( .not. zig_norm_initialized ) call zigset - iz = 0 - ! original algorithm use 32bit - hz = dist_rand(iz) - - iz = iand( hz, 127 ) - if( abs( hz ) < kn(iz) ) then - res = hz * wn(iz) - else - L1: do - L2: if( iz == 0 ) then - do - x = -log( uni( ) ) * rr - y = -log( uni( ) ) - if( y + y >= x * x ) exit - end do - res = r + x - if( hz <= 0 ) res = -res - exit L1 - end if L2 - x = hz * wn(iz) - if( fn(iz) + uni( ) * (fn(iz-1) - fn(iz)) < & - exp(-HALF * x * x) ) then - res = x - exit L1 - end if - - !original algorithm use 32bit - hz = dist_rand(iz) - iz = iand( hz, 127 ) - if( abs( hz ) < kn(iz) ) then - res = hz * wn(iz) - exit L1 - end if - end do L1 - end if - return - end function norm_dist_rvs_0_${t1[0]}$${k1}$ - - #:endfor - - #:for k1, t1 in REAL_KINDS_TYPES - impure elemental function norm_dist_rvs_${t1[0]}$${k1}$(loc, scale) & - result(res) - ! Normal random variate (loc, scale) - ! - ${t1}$, intent(in) :: loc, scale - ${t1}$ :: res - ${t1}$, parameter :: r = 3.442619855899_${k1}$, rr = 1.0_${k1}$ / r - ${t1}$ :: x, y - integer :: hz, iz - - if(scale==0._${k1}$) call error_stop("Error: Normal distribution scale" & - //" parameter must be non-zero") - if( .not. zig_norm_initialized ) call zigset - iz = 0 - ! original algorithm use 32bit - hz = dist_rand(iz) - - iz = iand( hz, 127 ) - if( abs( hz ) < kn(iz) ) then - res = hz * wn(iz) - else - L1: do - L2: if( iz == 0 ) then - do - x = -log( uni( ) ) * rr - y = -log( uni( ) ) - if( y + y >= x * x ) exit - end do - res = r + x - if( hz <= 0 ) res = -res - exit L1 - end if L2 - x = hz * wn(iz) - if( fn(iz) + uni( ) * (fn(iz-1) - fn(iz)) < & - exp(-HALF * x * x) ) then - res = x - exit L1 - end if - - !original algorithm use 32bit - hz = dist_rand(iz) - iz = iand( hz, 127 ) - if( abs( hz ) < kn(iz) ) then - res = hz * wn(iz) - exit L1 - end if - end do L1 - end if - res = res * scale + loc - return - end function norm_dist_rvs_${t1[0]}$${k1}$ - - #:endfor - - #:for k1, t1 in CMPLX_KINDS_TYPES - impure elemental function norm_dist_rvs_${t1[0]}$${k1}$(loc, scale) & - result(res) - ! Normal distributed complex. The real part and imaginary part are & - ! independent of each other. - ! - ${t1}$, intent(in) :: loc, scale - ${t1}$ :: res - real(${k1}$) :: tr, ti - - tr = norm_dist_rvs_r${k1}$(real(loc), real(scale)) - ti = norm_dist_rvs_r${k1}$(aimag(loc), aimag(scale)) - res = cmplx(tr, ti) - return - end function norm_dist_rvs_${t1[0]}$${k1}$ - - #:endfor - - #:for k1, t1 in REAL_KINDS_TYPES - function norm_dist_rvs_array_${t1[0]}$${k1}$(loc, scale, array_size) & - result(res) - ${t1}$, intent(in) :: loc, scale - integer, intent(in) :: array_size - ${t1}$, allocatable :: res(:) - ${t1}$, parameter :: r = 3.442619855899_${k1}$, rr = 1.0_${k1}$ / r - ${t1}$ :: x, y, re - integer :: hz, iz, i - - if(scale==0._${k1}$) call error_stop("Error: Normal distribution scale" & - //" parameter must be non-zero") - if( .not. zig_norm_initialized ) call zigset - allocate(res(array_size)) - do i = 1, array_size - iz = 0 - ! original algorithm use 32bit - hz = dist_rand(iz) - - 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( ) ) * rr - y = -log( uni( ) ) - 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( ) * (fn(iz-1) - fn(iz)) < & - exp(-HALF * x * x) ) then - re = x - exit L1 - end if - - !original algorithm use 32bit - hz = dist_rand(iz) - 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 * scale + loc - end do - return - end function norm_dist_rvs_array_${t1[0]}$${k1}$ - - #:endfor - - #:for k1, t1 in CMPLX_KINDS_TYPES - function norm_dist_rvs_array_${t1[0]}$${k1}$(loc, scale, array_size) & - result(res) - ${t1}$, intent(in) :: loc, scale - integer, intent(in) :: array_size - integer :: i - ${t1}$, allocatable :: res(:) - real(${k1}$) :: tr, ti - - allocate(res(array_size)) - do i = 1, array_size - tr = norm_dist_rvs_r${k1}$(real(loc), real(scale)) - ti = norm_dist_rvs_r${k1}$(aimag(loc), aimag(scale)) - res(i) = cmplx(tr, ti) - end do - return - end function norm_dist_rvs_array_${t1[0]}$${k1}$ - - #:endfor - - #:for k1, t1 in REAL_KINDS_TYPES - impure elemental function norm_dist_pdf_${t1[0]}$${k1}$(x, loc, scale) & - result(res) - ! Normal distributed probability function - ! - ${t1}$, intent(in) :: x, loc, scale - real :: res - ${t1}$, parameter :: sqrt_2_pi = sqrt(2.0_${k1}$ * acos(-1.0_${k1}$)) - - if(scale==0._${k1}$) call error_stop("Error: Normal distribution scale" & - //" parameter must be non-zero") - res = exp(- 0.5_${k1}$ * (x - loc) * (x - loc) / (scale * scale)) / & - (sqrt_2_Pi * scale) - return - end function norm_dist_pdf_${t1[0]}$${k1}$ - - #:endfor - - #:for k1, t1 in CMPLX_KINDS_TYPES - impure elemental function norm_dist_pdf_${t1[0]}$${k1}$(x, loc, scale) & - result(res) - ${t1}$, intent(in) :: x, loc, scale - real :: res - - res = norm_dist_pdf_r${k1}$(real(x), real(loc), real(scale)) - res = res * norm_dist_pdf_r${k1}$(aimag(x), aimag(loc), aimag(scale)) - return - end function norm_dist_pdf_${t1[0]}$${k1}$ - - #:endfor - - #:for k1, t1 in REAL_KINDS_TYPES - impure elemental function norm_dist_cdf_${t1[0]}$${k1}$(x, loc, scale) & - result(res) - ! Normal random cumulative distribution function - ! - ${t1}$, intent(in) :: x, loc, scale - real :: res - ${t1}$, parameter :: sqrt_2 = sqrt(2.0_${k1}$) - - if(scale==0._${k1}$) call error_stop("Error: Normal distribution scale" & - //" parameter must be non-zero") - res = (1.0_${k1}$ + erf((x - loc) / (scale * sqrt_2))) / 2.0_${k1}$ - return - end function norm_dist_cdf_${t1[0]}$${k1}$ - - #:endfor - - #:for k1, t1 in CMPLX_KINDS_TYPES - impure elemental function norm_dist_cdf_${t1[0]}$${k1}$(x, loc, scale) & - result(res) - ${t1}$, intent(in) :: x, loc, scale - real :: res - - res = norm_dist_cdf_r${k1}$(real(x), real(loc), real(scale)) - res = res * norm_dist_cdf_r${k1}$(aimag(x), aimag(loc), aimag(scale)) - return - end function norm_dist_cdf_${t1[0]}$${k1}$ - - #:endfor - -end module stdlib_stats_distribution_normal From 2f45d19d4eb8187ab76a794db965b2b83a168a63 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 27 Dec 2020 12:10:39 -0500 Subject: [PATCH 21/55] chg. complex number with kinds --- src/stdlib_stats_distribution_PRNG.fypp | 13 +++--- ...stdlib_stats_distribution_exponential.fypp | 40 +++++++++++-------- src/stdlib_stats_distribution_uniform.fypp | 16 ++++---- 3 files changed, 38 insertions(+), 31 deletions(-) diff --git a/src/stdlib_stats_distribution_PRNG.fypp b/src/stdlib_stats_distribution_PRNG.fypp index 90d9f367e..d1bda107a 100644 --- a/src/stdlib_stats_distribution_PRNG.fypp +++ b/src/stdlib_stats_distribution_PRNG.fypp @@ -1,9 +1,9 @@ #:include "common.fypp" module stdlib_stats_distribution_PRNG - use stdlib_kinds + use stdlib_kinds, only: int8, int16, int32, int64 implicit none private - integer, parameter :: MAX_INT_BIT_SIZE = 64 + integer, parameter :: MAX_INT_BIT_SIZE = bit_size(1_int64) integer(int64), save :: st(4), si = 614872703977525537_int64 logical, save :: seed_initialized = .false. @@ -43,7 +43,8 @@ module stdlib_stats_distribution_PRNG function dist_rand_${t1[0]}$${k1}$(n) result(res) !! Random integer generation for various kinds !! result = [-2^k, 2^k - 1], k = 7, 15, 31, 63, depending on input kind - !! Result is used as bit model number instead of regular arithmetic number + !! Result will be operated by bitwise operators to generate desired integer + !! and real pseudorandom numbers !! ${t1}$, intent(in) :: n ${t1}$ :: res @@ -58,6 +59,7 @@ module stdlib_stats_distribution_PRNG function xoshiro256ss( ) result (res) ! Generate random 64-bit integers ! Written in 2018 by David Blackman and Sebastiano Vigna (vigna@acm.org) + ! http://prng.di.unimi.it/xoshiro256starstar.c ! ! This is xoshiro256** 1.0, one of our all-purpose, rock-solid ! generators. It has excellent (sub-ns) speed, a state (256 bits) that is @@ -81,7 +83,6 @@ module stdlib_stats_distribution_PRNG st(1) = ieor(st(1), st(4)) st(3) = ieor(st(3), t) st(4) = rol64(st(4), 45) - return end function xoshiro256ss function rol64(x, k) result(res) @@ -92,7 +93,6 @@ module stdlib_stats_distribution_PRNG t1 = shiftr(x, (64 - k)) t2 = shiftl(x, k) res = ior(t1, t2) - return end function rol64 @@ -101,6 +101,7 @@ module stdlib_stats_distribution_PRNG ! to 2^128 calls to xoshiro256ss(); it can be used to generate 2^128 ! non-overlapping subsequences for parallel computations. ! Written in 2018 by David Blackman and Sebastiano Vigna (vigna@acm.org) + ! http://prng.di.unimi.it/xoshiro256starstar.c ! ! Fortran 90 version translated from C by Jim-215-Fisher integer(int64) :: jp(4) = [1733541517147835066_int64, & @@ -133,6 +134,7 @@ module stdlib_stats_distribution_PRNG ! 2^64 starting points, from each of which jump() will generate 2^64 ! non-overlapping subsequences for parallel distributed computations ! Written in 2018 by David Blackman and Sebastiano Vigna (vigna@acm.org) + ! http://prng.di.unimi.it/xoshiro256starstar.c ! ! Fortran 90 version translated from C by Jim-215-Fisher integer(int64) :: jp(4) = [8566230491382795199_int64, & @@ -183,7 +185,6 @@ module stdlib_stats_distribution_PRNG res = ieor(res, shiftr(res, 30)) * int02 res = ieor(res, shiftr(res, 27)) * int03 res = ieor(res, shiftr(res, 31)) - return end function splitmix64 #:for k1, t1 in INT_KINDS_TYPES diff --git a/src/stdlib_stats_distribution_exponential.fypp b/src/stdlib_stats_distribution_exponential.fypp index 6a3784bd8..059865865 100644 --- a/src/stdlib_stats_distribution_exponential.fypp +++ b/src/stdlib_stats_distribution_exponential.fypp @@ -21,7 +21,7 @@ Module stdlib_stats_distribution_expon !! Version experimental !! !! Exponential Distribution Random Variates - !!([Specification](../page/specs/stdlib_stats_distribution_expon.html# + !!([Specification](../page/specs/stdlib_stats_distribution_exponential.html# !! description)) !! module procedure exp_dist_rvs_0_rsp !0 dummy variable @@ -39,7 +39,7 @@ Module stdlib_stats_distribution_expon !! Version experimental !! !! Exponential Distribution Probability Density Function - !!([Specification](../page/specs/stdlib_stats_distribution_expon.html# + !!([Specification](../page/specs/stdlib_stats_distribution_exponential.html# !! description)) !! #:for k1, t1 in RC_KINDS_TYPES @@ -51,7 +51,7 @@ Module stdlib_stats_distribution_expon !! Version experimental !! !! Exponential Distribution Cumulative Distribution Function - !! ([Specification](../page/specs/stdlib_stats_distribution_expon.html# + !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# !! description)) !! #:for k1, t1 in RC_KINDS_TYPES @@ -77,6 +77,8 @@ Module stdlib_stats_distribution_expon ! unsigned integers in Fortran. ! ! Latest version - 1 January 2001 + ! + ! Fotran 90 program translated from C by Jim-215-Fisher ! real(dp), parameter :: M2 = 2147483648.0_dp real(dp) :: de = 7.697117470131487_dp, te, & @@ -115,7 +117,7 @@ Module stdlib_stats_distribution_expon ! Original algorithm use 32bit iz = 0 - jz = dist_rand(iz) + jz = dist_rand(1_int32) iz = iand( jz, 255 ) if( abs( jz ) < ke(iz) ) then @@ -123,17 +125,17 @@ Module stdlib_stats_distribution_expon else L1: do if( iz == 0 ) then - res = r - log( uni( ) ) + res = r - log( uni(1.0_${k1}$) ) exit L1 end if x = abs( jz ) * we(iz) - if( fe(iz) + uni( ) * (fe(iz-1) - fe(iz)) < exp( -x ) ) then + if(fe(iz) + uni(1.0_${k1}$) * (fe(iz-1) - fe(iz)) < exp(-x)) then res = x exit L1 end if !original algorithm use 32bit - jz = dist_rand(iz) + jz = dist_rand(1_int32) iz = iand( jz, 255 ) if( abs( jz ) < ke(iz) ) then res = abs( jz ) * we(iz) @@ -161,7 +163,7 @@ Module stdlib_stats_distribution_expon ! Original algorithm use 32bit iz = 0 - jz = dist_rand(iz) + jz = dist_rand(1_int32) iz = iand( jz, 255 ) if( abs( jz ) < ke(iz) ) then @@ -169,17 +171,17 @@ Module stdlib_stats_distribution_expon else L1: do if( iz == 0 ) then - res = r - log( uni( ) ) + res = r - log( uni(1.0_${k1}$) ) exit L1 end if x = abs( jz ) * we(iz) - if( fe(iz) + uni( ) * (fe(iz-1) - fe(iz)) < exp( -x ) ) then + if(fe(iz) + uni(1.0_${k1}$) * (fe(iz-1) - fe(iz)) < exp(-x)) then res = x exit L1 end if !original algorithm use 32bit - jz = dist_rand(iz) + jz = dist_rand(1_int32) iz = iand( jz, 255 ) if( abs( jz ) < ke(iz) ) then res = abs( jz ) * we(iz) @@ -201,7 +203,7 @@ Module stdlib_stats_distribution_expon tr = exp_dist_rvs_r${k1}$(real(lamda)) ti = exp_dist_rvs_r${k1}$(aimag(lamda)) - res = cmplx(tr, ti) + res = cmplx(tr, ti, kind=${k1}$) return end function exp_dist_rvs_${t1[0]}$${k1}$ @@ -223,7 +225,7 @@ Module stdlib_stats_distribution_expon do i =1, array_size ! Original algorithm use 32bit iz = 0 - jz = dist_rand(iz) + jz = dist_rand(1_int32) iz = iand( jz, 255 ) if( abs( jz ) < ke(iz) ) then @@ -231,17 +233,17 @@ Module stdlib_stats_distribution_expon else L1: do if( iz == 0 ) then - re = r - log( uni( ) ) + re = r - log( uni(1.0_${k1}$) ) exit L1 end if x = abs( jz ) * we(iz) - if( fe(iz) + uni( ) * (fe(iz-1) - fe(iz)) < exp( -x ) ) then + if(fe(iz) + uni(1.0_${k1}$)*(fe(iz-1)-fe(iz)) < exp(-x)) then re = x exit L1 end if !original algorithm use 32bit - jz = dist_rand(iz) + jz = dist_rand(1_int32) iz = iand( jz, 255 ) if( abs( jz ) < ke(iz) ) then re = abs( jz ) * we(iz) @@ -268,7 +270,7 @@ Module stdlib_stats_distribution_expon do i = 1, array_size tr = exp_dist_rvs_r${k1}$(real(lamda)) ti = exp_dist_rvs_r${k1}$(aimag(lamda)) - res(i) = cmplx(tr, ti) + res(i) = cmplx(tr, ti, kind=${k1}$) end do return end function exp_dist_rvs_array_${t1[0]}$${k1}$ @@ -284,6 +286,8 @@ Module stdlib_stats_distribution_expon if(lamda <= 0.0_${k1}$) call error_stop("Error: Exponential" & //" distribution lamda parameter must be greaeter than zero") + if(x < 0.0_${k1}$) call error_stop("Error: Exponential distribution" & + //" variate x must be non-negative") res = exp(- x * lamda) * lamda return end function exp_dist_pdf_${t1[0]}$${k1}$ @@ -311,6 +315,8 @@ Module stdlib_stats_distribution_expon if(lamda <= 0.0_${k1}$) call error_stop("Error: Exponential" & //" distribution lamda parameter must be greaeter than zero") + if(x < 0.0_${k1}$) call error_stop("Error: Exponential distribution" & + //" variate x must be non-negative") res = (1.0 - exp(- x * lamda)) return end function exp_dist_cdf_${t1[0]}$${k1}$ diff --git a/src/stdlib_stats_distribution_uniform.fypp b/src/stdlib_stats_distribution_uniform.fypp index d51680f0f..572caaf37 100644 --- a/src/stdlib_stats_distribution_uniform.fypp +++ b/src/stdlib_stats_distribution_uniform.fypp @@ -134,7 +134,7 @@ Module stdlib_stats_distribution_uniform ! Uniformly distributed float in [0,1] ! Based on the paper by Frederic Goualard, "Generating Random Floating- ! Point Numbers By Dividing Integers: a Case Study", Proceedings of - ! ICCS 2020, June 20202, Amsterdam, Netherlands + ! ICCS 2020, June 2020, Amsterdam, Netherlands ! ${t1}$ :: res integer(int64) :: tmp @@ -201,7 +201,7 @@ Module stdlib_stats_distribution_uniform tr = real(scale) * r1 ti = aimag(scale) * r2 endif - res = cmplx(tr, ti) + res = cmplx(tr, ti, kind=${k1}$) return end function unif_dist_rvs_1_${t1[0]}$${k1}$ @@ -233,7 +233,7 @@ Module stdlib_stats_distribution_uniform tr = real(loc) + real(scale) * r1 ti = aimag(loc) + aimag(scale) * r2 endif - res = cmplx(tr, ti) + res = cmplx(tr, ti, kind=${k1}$) return end function unif_dist_rvs_${t1[0]}$${k1}$ @@ -329,7 +329,7 @@ Module stdlib_stats_distribution_uniform tr = real(loc) + real(scale) * r1 ti = aimag(loc) + aimag(scale) * r2 endif - res(i) = cmplx(tr, ti) + res(i) = cmplx(tr, ti, kind=${k1}$) enddo return end function unif_dist_rvs_array_${t1[0]}$${k1}$ @@ -343,10 +343,10 @@ Module stdlib_stats_distribution_uniform if(scale == 0) then res = 0.0 - elseif(x < loc .or. x >loc + scale) then + elseif(x < loc .or. x > (loc + scale)) then res = 0.0 else - res = 1. / (scale + 1) + res = 1. / (scale + 1_${k1}$) end if return end function unif_dist_pdf_${t1[0]}$${k1}$ @@ -400,7 +400,7 @@ Module stdlib_stats_distribution_uniform elseif(x < loc) then res = 0.0 elseif(x >= loc .and. x <= (loc + scale)) then - res = real((x - loc + 1)) / real((scale + 1)) + res = real((x - loc + 1_${k1}$)) / real((scale + 1_${k1}$)) else res = 1.0 end if @@ -479,4 +479,4 @@ Module stdlib_stats_distribution_uniform end function shuffle_${t1[0]}$${k1}$ #:endfor -end module stdlib_stats_distribution_uniform +end module stdlib_stats_distribution_uniform \ No newline at end of file From fc17bbb3f049b5142dc6499943379d8e4e0cc081 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 27 Dec 2020 12:11:11 -0500 Subject: [PATCH 22/55] chg. complex number with kinds --- .../stats/test_distribution_exponential.f90 | 174 +++++++++--------- 1 file changed, 87 insertions(+), 87 deletions(-) diff --git a/src/tests/stats/test_distribution_exponential.f90 b/src/tests/stats/test_distribution_exponential.f90 index 3773ad9b9..6e3148676 100644 --- a/src/tests/stats/test_distribution_exponential.f90 +++ b/src/tests/stats/test_distribution_exponential.f90 @@ -151,26 +151,26 @@ subroutine test_expon_rvs_csp complex(sp) :: res(10), scale integer :: i, n, k = 5 integer :: seed, get - complex(sp) :: ans(10) = [(0.640164494514465332031250000000000000_sp, & - 0.268204987049102783203125000000000000_sp), & - (0.141667589545249938964843750000000000_sp, & - 2.60843825340270996093750000000000000_sp), & - (0.116705909371376037597656250000000000_sp, & - 1.04120576381683349609375000000000000_sp), & - (2.06742310523986816406250000000000000_sp, & - 0.723668336868286132812500000000000000_sp), & - (0.852514624595642089843750000000000000_sp, & - 0.789043843746185302734375000000000000_sp), & - (1.09098446369171142578125000000000000_sp, & - 1.48569476604461669921875000000000000_sp), & - (4.29633092880249023437500000000000000_sp, & - 0.338216394186019897460937500000000000_sp), & - (0.340462744235992431640625000000000000_sp, & - 0.172319442033767700195312500000000000_sp), & - (6.932352483272552490234375000000000000E-0002_sp, & - 6.742518395185470581054687500000000000E-0002_sp), & - (1.03231632709503173828125000000000000_sp, & - 0.421413004398345947265625000000000000_sp)] + complex(sp) :: ans(10) = [(0.640164505354053137153869101894088070_sp, & + 0.268204995991944639133208738712710328_sp), & + (0.141667583643866407117073435983911608_sp, & + 2.60843818343998017361684560455614716_sp), & + (0.116705911955157926040982374615850854_sp, & + 1.04120572522889689448533090398996145_sp), & + (2.06742299986664055388985161698656149_sp, & + 0.723668357086202707062483341360348315_sp), & + (0.852514651480446872255924972705542983_sp, & + 0.789043817146060844081034701957833041_sp), & + (1.09098446025458177821576555288629603_sp, & + 1.48569478096399141264782883808948111_sp), & + (4.29633077423243321391055360436439499_sp, & + 0.338216396454583145825267820328008412_sp), & + (0.340462754402863337910289942556119029_sp, & + 0.172319442815022222381671213042864120_sp), & + (6.932352666201882229746189523211795805E-0002_sp, & + 6.742518436285274002761624956292507704E-0002_sp), & + (1.03231628501970258415809666985296648_sp, & + 0.421413014732743429480166241773986277_sp)] print *, "Test exponential_distribution_rvs_csp" seed = 593742186 @@ -188,26 +188,26 @@ subroutine test_expon_rvs_cdp complex(dp) :: res(10), scale integer :: i, n, k = 5 integer :: seed, get - complex(dp) :: ans(10) = [(0.640164494514465332031250000000000000_dp, & - 0.268204987049102783203125000000000000_dp), & - (0.141667589545249938964843750000000000_dp, & - 2.60843825340270996093750000000000000_dp), & - (0.116705909371376037597656250000000000_dp, & - 1.04120576381683349609375000000000000_dp), & - (2.06742310523986816406250000000000000_dp, & - 0.723668336868286132812500000000000000_dp), & - (0.852514624595642089843750000000000000_dp, & - 0.789043843746185302734375000000000000_dp), & - (1.09098446369171142578125000000000000_dp, & - 1.48569476604461669921875000000000000_dp), & - (4.29633092880249023437500000000000000_dp, & - 0.338216394186019897460937500000000000_dp), & - (0.340462744235992431640625000000000000_dp, & - 0.172319442033767700195312500000000000_dp), & - (6.932352483272552490234375000000000000E-0002_dp, & - 6.742518395185470581054687500000000000E-0002_dp), & - (1.03231632709503173828125000000000000_dp, & - 0.421413004398345947265625000000000000_dp)] + complex(dp) :: ans(10) = [(0.640164505354053137153869101894088070_dp, & + 0.268204995991944639133208738712710328_dp), & + (0.141667583643866407117073435983911608_dp, & + 2.60843818343998017361684560455614716_dp), & + (0.116705911955157926040982374615850854_dp, & + 1.04120572522889689448533090398996145_dp), & + (2.06742299986664055388985161698656149_dp, & + 0.723668357086202707062483341360348315_dp), & + (0.852514651480446872255924972705542983_dp, & + 0.789043817146060844081034701957833041_dp), & + (1.09098446025458177821576555288629603_dp, & + 1.48569478096399141264782883808948111_dp), & + (4.29633077423243321391055360436439499_dp, & + 0.338216396454583145825267820328008412_dp), & + (0.340462754402863337910289942556119029_dp, & + 0.172319442815022222381671213042864120_dp), & + (6.932352666201882229746189523211795805E-0002_dp, & + 6.742518436285274002761624956292507704E-0002_dp), & + (1.03231628501970258415809666985296648_dp, & + 0.421413014732743429480166241773986277_dp)] print *, "Test exponential_distribution_rvs_cdp" seed = 593742186 @@ -225,26 +225,26 @@ subroutine test_expon_rvs_cqp complex(qp) :: res(10), scale integer :: i, n, k = 5 integer :: seed, get - complex(qp) :: ans(10) = [(0.640164494514465332031250000000000000_qp, & - 0.268204987049102783203125000000000000_qp), & - (0.141667589545249938964843750000000000_qp, & - 2.60843825340270996093750000000000000_qp), & - (0.116705909371376037597656250000000000_qp, & - 1.04120576381683349609375000000000000_qp), & - (2.06742310523986816406250000000000000_qp, & - 0.723668336868286132812500000000000000_qp), & - (0.852514624595642089843750000000000000_qp, & - 0.789043843746185302734375000000000000_qp), & - (1.09098446369171142578125000000000000_qp, & - 1.48569476604461669921875000000000000_qp), & - (4.29633092880249023437500000000000000_qp, & - 0.338216394186019897460937500000000000_qp), & - (0.340462744235992431640625000000000000_qp, & - 0.172319442033767700195312500000000000_qp), & - (6.932352483272552490234375000000000000E-0002_qp, & - 6.742518395185470581054687500000000000E-0002_qp), & - (1.03231632709503173828125000000000000_qp, & - 0.421413004398345947265625000000000000_qp)] + complex(qp) :: ans(10) = [(0.640164505354053137153869101894088070_qp, & + 0.268204995991944639133208738712710328_qp), & + (0.141667583643866407117073435983911608_qp, & + 2.60843818343998017361684560455614716_qp), & + (0.116705911955157926040982374615850854_qp, & + 1.04120572522889689448533090398996145_qp), & + (2.06742299986664055388985161698656149_qp, & + 0.723668357086202707062483341360348315_qp), & + (0.852514651480446872255924972705542983_qp, & + 0.789043817146060844081034701957833041_qp), & + (1.09098446025458177821576555288629603_qp, & + 1.48569478096399141264782883808948111_qp), & + (4.29633077423243321391055360436439499_qp, & + 0.338216396454583145825267820328008412_qp), & + (0.340462754402863337910289942556119029_qp, & + 0.172319442815022222381671213042864120_qp), & + (6.932352666201882229746189523211795805E-0002_qp, & + 6.742518436285274002761624956292507704E-0002_qp), & + (1.03231628501970258415809666985296648_qp, & + 0.421413014732743429480166241773986277_qp)] print *, "Test exponential_distribution_rvs_cqp" seed = 593742186 @@ -334,11 +334,11 @@ subroutine test_expon_pdf_csp integer :: i, n integer :: seed, get real :: res(3,5) - real :: ans(15) = [0.386471182, 0.386471182,0.386471182, 2.79592816E-03,& - 4.01333207E-03, 0.317740440, 0.385551631, & - 5.02163824E-03, 0.372386932, 6.09764457E-03, & - 0.273956627, 0.407586545, 1.59074634E-03,0.136133015,& - 0.399842113] + real :: ans(15) = [0.386471182, 0.386471182,0.386471182,2.79592793E-03, & + 4.01333207E-03, 0.317740440, 0.385551631, & + 5.02163777E-03, 0.372386932, 6.09764457E-03, & + 0.273956627, 0.407586545, 1.59074657E-03, & + 0.136133000, 0.399842113] print *, "Test exponential_distribution_pdf_csp" seed = 123987654 @@ -357,11 +357,11 @@ subroutine test_expon_pdf_cdp integer :: i, n integer :: seed, get real :: res(3,5) - real :: ans(15) = [0.386471182, 0.386471182,0.386471182, 2.79592816E-03,& - 4.01333207E-03, 0.317740440, 0.385551631, & - 5.02163824E-03, 0.372386932, 6.09764457E-03, & - 0.273956627, 0.407586545, 1.59074634E-03,0.136133015,& - 0.399842113] + real :: ans(15) = [0.386471182, 0.386471182,0.386471182,2.79592793E-03, & + 4.01333207E-03, 0.317740440, 0.385551631, & + 5.02163777E-03, 0.372386932, 6.09764457E-03, & + 0.273956627, 0.407586545, 1.59074657E-03, & + 0.136133000, 0.399842113] print *, "Test exponential_distribution_pdf_cdp" seed = 123987654 @@ -380,11 +380,11 @@ subroutine test_expon_pdf_cqp integer :: i, n integer :: seed, get real :: res(3,5) - real :: ans(15) = [0.386471182, 0.386471182,0.386471182, 2.79592816E-03,& - 4.01333207E-03, 0.317740440, 0.385551631, & - 5.02163824E-03, 0.372386932, 6.09764457E-03, & - 0.273956627, 0.407586545, 1.59074634E-03,0.136133015,& - 0.399842113] + real :: ans(15) = [0.386471182, 0.386471182,0.386471182,2.79592793E-03, & + 4.01333207E-03, 0.317740440, 0.385551631, & + 5.02163777E-03, 0.372386932, 6.09764457E-03, & + 0.273956627, 0.407586545, 1.59074657E-03, & + 0.136133000, 0.399842113] print *, "Test exponential_distribution_pdf_cqp" seed = 123987654 @@ -473,10 +473,10 @@ subroutine test_expon_cdf_csp integer :: i, n integer :: seed, get real :: res(3,5) - real :: ans(15) = [0.176930442,0.176930442,0.176930442, 5.98644949E-02, & - 0.981560826,0.135309443,0.617795825, 7.55468607E-02, & - 0.118341736, 0.484595388, 0.794088185, 0.912919402, & - 0.914170802, 0.370377690, 0.793968201] + real :: ans(15) = [0.176930442, 0.176930442, 0.176930442,5.98644912E-02,& + 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& + 0.118341751, 0.484595388, 0.794088185, 0.912919402, & + 0.914170802, 0.370377690, 0.793968141] print *, "Test exponential_distribution_cdf_csp" seed = 621957438 @@ -496,10 +496,10 @@ subroutine test_expon_cdf_cdp integer :: i, n integer :: seed, get real :: res(3,5) - real :: ans(15) = [0.176930442,0.176930442,0.176930442, 5.98644949E-02, & - 0.981560826,0.135309443,0.617795825, 7.55468607E-02, & - 0.118341736, 0.484595388, 0.794088185, 0.912919402, & - 0.914170802, 0.370377690, 0.793968201] + real :: ans(15) = [0.176930442, 0.176930442, 0.176930442,5.98644912E-02,& + 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& + 0.118341751, 0.484595388, 0.794088185, 0.912919402, & + 0.914170802, 0.370377690, 0.793968141] print *, "Test exponential_distribution_cdf_cdp" seed = 621957438 @@ -519,10 +519,10 @@ subroutine test_expon_cdf_cqp integer :: i, n integer :: seed, get real :: res(3,5) - real :: ans(15) = [0.176930442,0.176930442,0.176930442, 5.98644949E-02, & - 0.981560826,0.135309443,0.617795825, 7.55468607E-02, & - 0.118341736, 0.484595388, 0.794088185, 0.912919402, & - 0.914170802, 0.370377690, 0.793968201] + real :: ans(15) = [0.176930442, 0.176930442, 0.176930442,5.98644912E-02,& + 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& + 0.118341751, 0.484595388, 0.794088185, 0.912919402, & + 0.914170802, 0.370377690, 0.793968141] print *, "Test exponential_distribution_cdf_cqp" seed = 621957438 From dc6e894a6929c6356741c1a015b1ddc9c58ed32e Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 27 Dec 2020 12:12:13 -0500 Subject: [PATCH 23/55] Update index.md --- doc/specs/index.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/index.md b/doc/specs/index.md index e136487e1..22408000d 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -20,7 +20,7 @@ This is and index/directory of the specifications (specs) for each new module/fe - [stats_distribution_PRNG](./stdlib_stats_distribution_PRNG.html) - Probability Distributions random number generator - [stats_distribution_uniform](./stdlib_stats_distribution_uniform.html) - Uniform probability distribution - [stats_distribution_normal](./stdlib_stats_distribution_normal.html) - Normal probability distribution - - [stats_distribution_exponential](./stdlib_stats_distribution_exponential.html) - Exponential probability distribution + - [stats_distribution_expon](./stdlib_stats_distribution_exponential.html) - Exponential probability distribution ## Missing specs From 8465f77738137a455e1c7f229d61ec1ea490d720 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 27 Dec 2020 12:13:09 -0500 Subject: [PATCH 24/55] Delete test_distribution_normal.f90 --- src/tests/stats/test_distribution_normal.f90 | 557 ------------------- 1 file changed, 557 deletions(-) delete mode 100644 src/tests/stats/test_distribution_normal.f90 diff --git a/src/tests/stats/test_distribution_normal.f90 b/src/tests/stats/test_distribution_normal.f90 deleted file mode 100644 index fbb0bdaf7..000000000 --- a/src/tests/stats/test_distribution_normal.f90 +++ /dev/null @@ -1,557 +0,0 @@ -program test_distribution_normal - use stdlib_kinds - use stdlib_error, only : check - use stdlib_stats_distribution_PRNG, only : random_seed - use stdlib_stats_distribution_normal, nor_rvs => normal_distribution_rvs, & - nor_pdf => normal_distribution_pdf, & - nor_cdf => normal_distribution_cdf - - implicit none - real(sp), parameter :: sptol = 1000 * epsilon(1.0_sp) - real(dp), parameter :: dptol = 1000 * epsilon(1.0_dp) - real(qp), parameter :: qptol = 1000 * epsilon(1.0_qp) - logical :: warn = .true. - integer :: put, get - real :: x(2,3,4),a(2,3,4), b(2,3,4) - complex :: loc, scale - - put = 12345678 - call random_seed(put, get) - - call test_normal_random_generator - - call test_nor_rvs_rsp - call test_nor_rvs_rdp - call test_nor_rvs_rqp - call test_nor_rvs_csp - call test_nor_rvs_cdp - call test_nor_rvs_cqp - - call test_nor_pdf_rsp - call test_nor_pdf_rdp - call test_nor_pdf_rqp - call test_nor_pdf_csp - call test_nor_pdf_cdp - call test_nor_pdf_cqp - - call test_nor_cdf_rsp - call test_nor_cdf_rdp - call test_nor_cdf_rqp - call test_nor_cdf_csp - call test_nor_cdf_cdp - call test_nor_cdf_cqp - stop - - - contains - - - subroutine test_normal_random_generator - integer :: i, j, freq(0:1000), num=10000000 - real(dp) :: chisq, expct - - print *, "" - print *, "Test normal random generator with chi-squared" - freq = 0 - do i = 1, num - j = 1000 * (1 + erf(nor_rvs(0.0, 1.0) / sqrt(2.0))) / 2.0 - freq(j) = freq(j) + 1 - end do - chisq = 0.0_dp - expct = num / 1000 - do i = 0, 999 - chisq = chisq + (freq(i) - expct) ** 2 / expct - end do - write(*,*) "The critical values for chi-squared with 1000 d. of f. is" & - //" 1143.92" - write(*,*) "Chi-squared for normal random generator is : ", chisq - call check((chisq < 1143.9), & - msg="normal randomness failed chi-squared test", warn=warn) - end subroutine test_normal_random_generator - - - subroutine test_nor_rvs_rsp - real(sp) :: res(10), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - real(sp) :: ans(10) = [2.66708039318040679432897377409972250_sp, & - 2.36030794936128329730706809641560540_sp, & - 1.27712218793084242296487218482070602_sp, & - -2.39132544130814794769435138732660562_sp, & - 1.72566595106028652928387145948363468_sp, & - -1.50621775537767632613395107910037041_sp, & - 2.13518835158352082714827702147886157_sp, & - -0.636788253742142318358787633769679815_sp, & - 2.48600787778845799813609573902795091_sp, & - -3.03711473837981227319460231228731573_sp] - - print *, "Test normal_distribution_rvs_rsp" - seed = 25836914 - call random_seed(seed, get) - - loc = 0.5_sp; scale = 2.0_sp - do i = 1, k - res(i) = nor_rvs(loc, scale) ! 2 dummies - end do - res(6:10) = nor_rvs(loc, scale, k) ! 3 dummies - call check(all(abs(res - ans) < sptol), & - msg="normal_distribution_rvs_rsp failed", warn=warn) - end subroutine test_nor_rvs_rsp - - subroutine test_nor_rvs_rdp - real(dp) :: res(10), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - real(dp) :: ans(10) = [2.66708039318040679432897377409972250_dp, & - 2.36030794936128329730706809641560540_dp, & - 1.27712218793084242296487218482070602_dp, & - -2.39132544130814794769435138732660562_dp, & - 1.72566595106028652928387145948363468_dp, & - -1.50621775537767632613395107910037041_dp, & - 2.13518835158352082714827702147886157_dp, & - -0.636788253742142318358787633769679815_dp, & - 2.48600787778845799813609573902795091_dp, & - -3.03711473837981227319460231228731573_dp] - - print *, "Test normal_distribution_rvs_rdp" - seed = 25836914 - call random_seed(seed, get) - - loc = 0.5_dp; scale = 2.0_dp - do i = 1, k - res(i) = nor_rvs(loc, scale) ! 2 dummies - end do - res(6:10) = nor_rvs(loc, scale, k) ! 3 dummies - call check(all(abs(res - ans) < dptol), & - msg="normal_distribution_rvs_rdp failed", warn=warn) - end subroutine test_nor_rvs_rdp - - subroutine test_nor_rvs_rqp - real(qp) :: res(10), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - real(qp) :: ans(10) = [2.66708039318040679432897377409972250_qp, & - 2.36030794936128329730706809641560540_qp, & - 1.27712218793084242296487218482070602_qp, & - -2.39132544130814794769435138732660562_qp, & - 1.72566595106028652928387145948363468_qp, & - -1.50621775537767632613395107910037041_qp, & - 2.13518835158352082714827702147886157_qp, & - -0.636788253742142318358787633769679815_qp, & - 2.48600787778845799813609573902795091_qp, & - -3.03711473837981227319460231228731573_qp] - - print *, "Test normal_distribution_rvs_rqp" - seed = 25836914 - call random_seed(seed, get) - - loc = 0.5_qp; scale = 2.0_qp - do i = 1, k - res(i) = nor_rvs(loc, scale) ! 2 dummies - end do - res(6:10) = nor_rvs(loc, scale, k) ! 3 dummies - call check(all(abs(res - ans) < qptol), & - msg="normal_distribution_rvs_rqp failed", warn=warn) - end subroutine test_nor_rvs_rqp - - subroutine test_nor_rvs_csp - complex(sp) :: res(10), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - complex(sp) :: ans(10) = [(2.12531018257141113281250000000000000_sp, & - 1.46507704257965087890625000000000000_sp), & - (1.08284163475036621093750000000000000_sp, & - 0.277168631553649902343750000000000000_sp), & - (1.41924941539764404296875000000000000_sp, & - 0.498445570468902587890625000000000000_sp), & - (1.72639131546020507812500000000000000_sp, & - 0.715802907943725585937500000000000000_sp), & - (1.98950588703155517578125000000000000_sp, & - 0.115721315145492553710937500000000000_sp), & - (-1.16929018497467041015625000000000000_sp, & - 0.250744730234146118164062500000000000_sp), & - (1.57160544395446777343750000000000000_sp, & - 0.638282597064971923828125000000000000_sp), & - (-1.36106109619140625000000000000000000_sp, & - 0.166259199380874633789062500000000000_sp), & - (1.13403093814849853515625000000000000_sp, & - 1.04232621192932128906250000000000000_sp), & - (-1.68220531940460205078125000000000000_sp, & - 1.63361442089080810546875000000000000_sp)] - - print *, "Test normal_distribution_rvs_csp" - seed = 25836914 - call random_seed(seed, get) - - loc = (0.5_sp, 1.0_sp); scale = (1.5_sp, 0.5_sp) - do i = 1, k - res(i) = nor_rvs(loc, scale) ! 2 dummies - end do - res(6:10) = nor_rvs(loc, scale, k) ! 3 dummies - call check(all(abs(real(res) - real(ans)) < sptol) .and. & - all(abs(aimag(res) - aimag(ans)) < sptol), & - msg="normal_distribution_rvs_csp failed", warn=warn) - end subroutine test_nor_rvs_csp - - subroutine test_nor_rvs_cdp - complex(dp) :: res(10), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - complex(dp) :: ans(10) = [(2.12531018257141113281250000000000000_dp, & - 1.46507704257965087890625000000000000_dp), & - (1.08284163475036621093750000000000000_dp, & - 0.277168631553649902343750000000000000_dp), & - (1.41924941539764404296875000000000000_dp, & - 0.498445570468902587890625000000000000_dp), & - (1.72639131546020507812500000000000000_dp, & - 0.715802907943725585937500000000000000_dp), & - (1.98950588703155517578125000000000000_dp, & - 0.115721315145492553710937500000000000_dp), & - (-1.16929018497467041015625000000000000_dp, & - 0.250744730234146118164062500000000000_dp), & - (1.57160544395446777343750000000000000_dp, & - 0.638282597064971923828125000000000000_dp), & - (-1.36106109619140625000000000000000000_dp, & - 0.166259199380874633789062500000000000_dp), & - (1.13403093814849853515625000000000000_dp, & - 1.04232621192932128906250000000000000_dp), & - (-1.68220531940460205078125000000000000_dp, & - 1.63361442089080810546875000000000000_dp)] - - print *, "Test normal_distribution_rvs_cdp" - seed = 25836914 - call random_seed(seed, get) - - loc = (0.5_dp, 1.0_dp); scale = (1.5_dp, 0.5_dp) - do i = 1, k - res(i) = nor_rvs(loc, scale) ! 2 dummies - end do - res(6:10) = nor_rvs(loc, scale, k) ! 3 dummies - call check(all(abs(real(res) - real(ans)) < dptol) .and. & - all(abs(aimag(res) - aimag(ans)) < dptol), & - msg="normal_distribution_rvs_cdp failed", warn=warn) - end subroutine test_nor_rvs_cdp - - subroutine test_nor_rvs_cqp - complex(qp) :: res(10), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - complex(qp) :: ans(10) = [(2.12531018257141113281250000000000000_qp, & - 1.46507704257965087890625000000000000_qp), & - (1.08284163475036621093750000000000000_qp, & - 0.277168631553649902343750000000000000_qp), & - (1.41924941539764404296875000000000000_qp, & - 0.498445570468902587890625000000000000_qp), & - (1.72639131546020507812500000000000000_qp, & - 0.715802907943725585937500000000000000_qp), & - (1.98950588703155517578125000000000000_qp, & - 0.115721315145492553710937500000000000_qp), & - (-1.16929018497467041015625000000000000_qp, & - 0.250744730234146118164062500000000000_qp), & - (1.57160544395446777343750000000000000_qp, & - 0.638282597064971923828125000000000000_qp), & - (-1.36106109619140625000000000000000000_qp, & - 0.166259199380874633789062500000000000_qp), & - (1.13403093814849853515625000000000000_qp, & - 1.04232621192932128906250000000000000_qp), & - (-1.68220531940460205078125000000000000_qp, & - 1.63361442089080810546875000000000000_qp)] - - print *, "Test normal_distribution_rvs_cqp" - seed = 25836914 - call random_seed(seed, get) - - loc = (0.5_qp, 1.0_qp); scale = (1.5_qp, 0.5_qp) - do i = 1, k - res(i) = nor_rvs(loc, scale) ! 2 dummies - end do - res(6:10) = nor_rvs(loc, scale, k) ! 3 dummies - call check(all(abs(real(res) - real(ans)) < qptol) .and. & - all(abs(aimag(res) - aimag(ans)) < qptol), & - msg="normal_distribution_rvs_cqp failed", warn=warn) - end subroutine test_nor_rvs_cqp - - - - subroutine test_nor_pdf_rsp - real(sp) :: x1, x2(3,4), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.215050772, 0.215050772, 0.215050772, 0.200537622, & - 5.66161536E-02, 0.238986954, 0.265935957,0.262147546,& - 0.249866411, 3.98721099E-02, 0.265902370,0.161311597,& - 0.249177739, 0.237427220, 0.155696079] - - print *, "Test normal_distribution_pdf_rsp" - seed = 741852963 - call random_seed(seed, get) - - loc = -0.5_sp; scale = 1.5_sp - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_pdf(x1, loc, scale) - res(:, 2:5) = nor_pdf(x2, loc, scale) - call check(all(abs(res - reshape(ans, [3,5])) < sptol), & - msg="normal_distribution_pdf_rsp failed", warn=warn) - end subroutine test_nor_pdf_rsp - - subroutine test_nor_pdf_rdp - real(dp) :: x1, x2(3,4), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.215050772, 0.215050772, 0.215050772, 0.200537622, & - 5.66161536E-02, 0.238986954, 0.265935957,0.262147546,& - 0.249866411, 3.98721099E-02, 0.265902370,0.161311597,& - 0.249177739, 0.237427220, 0.155696079] - - print *, "Test normal_distribution_pdf_rdp" - seed = 741852963 - call random_seed(seed, get) - - loc = -0.5_dp; scale = 1.5_dp - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_pdf(x1, loc, scale) - res(:, 2:5) = nor_pdf(x2, loc, scale) - call check(all(abs(res - reshape(ans, [3,5])) < dptol), & - msg="normal_distribution_pdf_rdp failed", warn=warn) - end subroutine test_nor_pdf_rdp - - subroutine test_nor_pdf_rqp - real(qp) :: x1, x2(3,4), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.215050772, 0.215050772, 0.215050772, 0.200537622, & - 5.66161536E-02, 0.238986954, 0.265935957,0.262147546,& - 0.249866411, 3.98721099E-02, 0.265902370,0.161311597,& - 0.249177739, 0.237427220, 0.155696079] - - print *, "Test normal_distribution_pdf_rqp" - seed = 741852963 - call random_seed(seed, get) - - loc = -0.5_qp; scale = 1.5_qp - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_pdf(x1, loc, scale) - res(:, 2:5) = nor_pdf(x2, loc, scale) - call check(all(abs(res - reshape(ans, [3,5])) < qptol), & - msg="normal_distribution_pdf_rqp failed", warn=warn) - end subroutine test_nor_pdf_rqp - - subroutine test_nor_pdf_csp - complex(sp) :: x1, x2(3,4), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.129377306, 0.129377306, 0.129377306,4.05915640E-02,& - 0.209143385, 2.98881028E-02,0.128679410, 0.177484736,& - 3.82205285E-02, 7.09915683E-02, 4.56126593E-02, & - 6.57454208E-02,0.165161029,3.86104845E-02,0.196922958] - - print *, "Test normal_distribution_pdf_csp" - seed = 741852963 - call random_seed(seed, get) - - loc = (-0.5_sp, 0.5_sp); scale = (0.5_sp, 1.5_sp) - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_pdf(x1, loc, scale) - res(:, 2:5) = nor_pdf(x2, loc, scale) - call check(all(abs(res - reshape(ans, [3,5])) < sptol), & - msg="normal_distribution_pdf_csp failed", warn=warn) - end subroutine test_nor_pdf_csp - - subroutine test_nor_pdf_cdp - complex(dp) :: x1, x2(3,4), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.129377306, 0.129377306, 0.129377306,4.05915640E-02,& - 0.209143385, 2.98881028E-02,0.128679410, 0.177484736,& - 3.82205285E-02, 7.09915683E-02, 4.56126593E-02, & - 6.57454208E-02,0.165161029,3.86104845E-02,0.196922958] - - print *, "Test normal_distribution_pdf_cdp" - seed = 741852963 - call random_seed(seed, get) - - loc = (-0.5_dp, 0.5_dp); scale = (0.5_dp, 1.5_dp) - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_pdf(x1, loc, scale) - res(:, 2:5) = nor_pdf(x2, loc, scale) - call check(all(abs(res - reshape(ans, [3,5])) < dptol), & - msg="normal_distribution_pdf_cdp failed", warn=warn) - end subroutine test_nor_pdf_cdp - - subroutine test_nor_pdf_cqp - complex(qp) :: x1, x2(3,4), loc, scale - integer :: i, n, k = 5 - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.129377306, 0.129377306, 0.129377306,4.05915640E-02,& - 0.209143385, 2.98881028E-02,0.128679410, 0.177484736,& - 3.82205285E-02, 7.09915683E-02, 4.56126593E-02, & - 6.57454208E-02,0.165161029,3.86104845E-02,0.196922958] - - print *, "Test normal_distribution_pdf_cqp" - seed = 741852963 - call random_seed(seed, get) - - loc = (-0.5_qp, 0.5_qp); scale = (0.5_qp, 1.5_qp) - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_pdf(x1, loc, scale) - res(:, 2:5) = nor_pdf(x2, loc, scale) - call check(all(abs(res - reshape(ans, [3,5])) < qptol), & - msg="normal_distribution_pdf_cqp failed", warn=warn) - end subroutine test_nor_pdf_cqp - - - subroutine test_nor_cdf_rsp - real(sp) :: x1, x2(3,4), loc, scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [7.50826299E-02, 7.50826299E-02, 7.50826299E-02, & - 0.143119827, 0.241425425, 0.284345865, 0.233239830, & - 0.341059506,0.353156865,6.81066737E-02,4.38792333E-02,& - 0.763679624, 0.363722175, 0.868187129, 0.626506805] - - print *, "Test normal_distribution_cdf_rsp" - seed = 369147582 - call random_seed(seed, get) - - loc = -1.0_sp; scale = 2.0_sp - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_cdf(x1, loc, scale) - res(:, 2:5) = nor_cdf(x2, loc, scale) - call check(all(abs(res - reshape(ans,[3,5])) < sptol), & - msg="normal_distribution_cdf_rsp failed", warn=warn) - end subroutine test_nor_cdf_rsp - - subroutine test_nor_cdf_rdp - real(dp) :: x1, x2(3,4), loc, scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [7.50826299E-02, 7.50826299E-02, 7.50826299E-02, & - 0.143119827, 0.241425425, 0.284345865, 0.233239830, & - 0.341059506,0.353156865,6.81066737E-02,4.38792333E-02,& - 0.763679624, 0.363722175, 0.868187129, 0.626506805] - - print *, "Test normal_distribution_cdf_rdp" - seed = 369147582 - call random_seed(seed, get) - - loc = -1.0_dp; scale = 2.0_dp - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_cdf(x1, loc, scale) - res(:, 2:5) = nor_cdf(x2, loc, scale) - call check(all(abs(res - reshape(ans,[3,5])) < dptol), & - msg="normal_distribution_cdf_rdp failed", warn=warn) - end subroutine test_nor_cdf_rdp - - subroutine test_nor_cdf_rqp - real(qp) :: x1, x2(3,4), loc, scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [7.50826299E-02, 7.50826299E-02, 7.50826299E-02, & - 0.143119827, 0.241425425, 0.284345865, 0.233239830, & - 0.341059506,0.353156865,6.81066737E-02,4.38792333E-02,& - 0.763679624, 0.363722175, 0.868187129, 0.626506805] - - print *, "Test normal_distribution_cdf_rqp" - seed = 369147582 - call random_seed(seed, get) - - loc = -1.0_qp; scale = 2.0_qp - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_cdf(x1, loc, scale) - res(:, 2:5) = nor_cdf(x2, loc, scale) - call check(all(abs(res - reshape(ans,[3,5])) < qptol), & - msg="normal_distribution_cdf_rqp failed", warn=warn) - end subroutine test_nor_cdf_rqp - - subroutine test_nor_cdf_csp - complex(sp) :: x1, x2(3,4), loc, scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [1.07458141E-02, 1.07458141E-02, 1.07458141E-02, & - 6.86483160E-02, 7.95486569E-02, 2.40523368E-02, & - 3.35096717E-02, 0.315778911,0.446311295,0.102010213, & - 7.66918957E-02, 0.564691007, 0.708769500, & - 6.40553832E-02, 5.39999120E-02] - - print *, "Test normal_distribution_cdf_csp" - seed = 369147582 - call random_seed(seed, get) - - loc = (-1.0_sp, 1.0_sp); scale = (1.7_sp, 2.4_sp) - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_cdf(x1, loc, scale) - res(:, 2:5) = nor_cdf(x2, loc, scale) - call check(all(abs(res - reshape(ans,[3,5])) < sptol), & - msg="normal_distribution_cdf_csp failed", warn=warn) - end subroutine test_nor_cdf_csp - - subroutine test_nor_cdf_cdp - complex(dp) :: x1, x2(3,4), loc, scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [1.07458141E-02, 1.07458141E-02, 1.07458141E-02, & - 6.86483160E-02, 7.95486569E-02, 2.40523368E-02, & - 3.35096717E-02, 0.315778911,0.446311295,0.102010213, & - 7.66918957E-02, 0.564691007, 0.708769500, & - 6.40553832E-02, 5.39999120E-02] - - print *, "Test normal_distribution_cdf_cdp" - seed = 369147582 - call random_seed(seed, get) - - loc = (-1.0_dp, 1.0_dp); scale = (1.7_dp, 2.4_dp) - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_cdf(x1, loc, scale) - res(:, 2:5) = nor_cdf(x2, loc, scale) - call check(all(abs(res - reshape(ans,[3,5])) < dptol), & - msg="normal_distribution_cdf_cdp failed", warn=warn) - end subroutine test_nor_cdf_cdp - - subroutine test_nor_cdf_cqp - complex(qp) :: x1, x2(3,4), loc, scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [1.07458141E-02, 1.07458141E-02, 1.07458141E-02, & - 6.86483160E-02, 7.95486569E-02, 2.40523368E-02, & - 3.35096717E-02, 0.315778911,0.446311295,0.102010213, & - 7.66918957E-02, 0.564691007, 0.708769500, & - 6.40553832E-02, 5.39999120E-02] - - print *, "Test normal_distribution_cdf_cqp" - seed = 369147582 - call random_seed(seed, get) - - loc = (-1.0_qp, 1.0_qp); scale = (1.7_qp, 2.4_qp) - x1 = nor_rvs(loc, scale) - x2 = reshape(nor_rvs(loc, scale, 12), [3,4]) - res(:,1) = nor_cdf(x1, loc, scale) - res(:, 2:5) = nor_cdf(x2, loc, scale) - call check(all(abs(res - reshape(ans,[3,5])) < qptol), & - msg="normal_distribution_cdf_cqp failed", warn=warn) - end subroutine test_nor_cdf_cqp - - -end program test_distribution_normal \ No newline at end of file From 5c99c7893d01ebffc4992623207806c24f15a0de Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 27 Dec 2020 12:17:58 -0500 Subject: [PATCH 25/55] Update CMakeLists.txt --- src/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index e9414febd..3b787b0cc 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -20,7 +20,6 @@ set(fppFiles stdlib_quadrature_simps.fypp stdlib_stats_distribution_PRNG.fypp stdlib_stats_distribution_uniform.fypp - stdlib_stats_distribution_normal.fypp stdlib_stats_distribution_exponential.fypp ) From a2447d2df2c3514a7392afa949f1a5e63095887d Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 27 Dec 2020 12:18:44 -0500 Subject: [PATCH 26/55] Update Makefile.manual --- src/Makefile.manual | 7 ------- 1 file changed, 7 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 9bcdb86ba..09b9af835 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -18,7 +18,6 @@ SRC = f18estop.f90 \ stdlib_stats_var.f90 \ stdlib_stats_distribution_PRNG.f90 \ stdlib_stats_distribution_uniform.f90 \ - stdlib_stats_distribution_normal.f90 \ stdlib_stats_distribution_exponential.f90 LIB = libstdlib.a @@ -76,11 +75,6 @@ stdlib_stats_distribution_uniform.o: \ stdlib_kinds.o \ stdlib_error.o \ stdlib_stats_distribution_PRNG.o -stdlib_stats_distribution_normal.o: \ - stdlib_kinds.o \ - stdlib_error.o \ - stdlib_stats_distribution_PRNG.o \ - stdlib_stats_distribution_uniform.o stdlib_stats_distribution_exponential.o: \ stdlib_kinds.o \ stdlib_error.o \ @@ -101,5 +95,4 @@ stdlib_stats_moment.f90: stdlib_stats_moment.fypp stdlib_stats_var.f90: stdlib_stats_var.fypp stdlib_stats_distribution_PRNG.f90: stdlib_stats_distribution_PRNG.fypp stdlib_stats_distribution_uniform.f90: stdlib_stats_distribution_uniform.fypp -stdlib_stats_distribution_normal.f90: stdlib_stats_distribution_normal.fypp stdlib_stats_distribution_exponential.f90: stdlib_stats_distribution_exponential.fypp From e760b8b2d293afb72a63a007eb0138576f5d44de Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 27 Dec 2020 12:28:18 -0500 Subject: [PATCH 27/55] remove tabs --- .../stats/test_distribution_exponential.f90 | 138 +++++++++--------- 1 file changed, 69 insertions(+), 69 deletions(-) diff --git a/src/tests/stats/test_distribution_exponential.f90 b/src/tests/stats/test_distribution_exponential.f90 index 6e3148676..e7aa9cd34 100644 --- a/src/tests/stats/test_distribution_exponential.f90 +++ b/src/tests/stats/test_distribution_exponential.f90 @@ -152,25 +152,25 @@ subroutine test_expon_rvs_csp integer :: i, n, k = 5 integer :: seed, get complex(sp) :: ans(10) = [(0.640164505354053137153869101894088070_sp, & - 0.268204995991944639133208738712710328_sp), & + 0.268204995991944639133208738712710328_sp), & (0.141667583643866407117073435983911608_sp, & - 2.60843818343998017361684560455614716_sp), & - (0.116705911955157926040982374615850854_sp, & - 1.04120572522889689448533090398996145_sp), & - (2.06742299986664055388985161698656149_sp, & - 0.723668357086202707062483341360348315_sp), & - (0.852514651480446872255924972705542983_sp, & - 0.789043817146060844081034701957833041_sp), & - (1.09098446025458177821576555288629603_sp, & - 1.48569478096399141264782883808948111_sp), & - (4.29633077423243321391055360436439499_sp, & - 0.338216396454583145825267820328008412_sp), & - (0.340462754402863337910289942556119029_sp, & - 0.172319442815022222381671213042864120_sp), & + 2.60843818343998017361684560455614716_sp), & + (0.116705911955157926040982374615850854_sp, & + 1.04120572522889689448533090398996145_sp), & + (2.06742299986664055388985161698656149_sp, & + 0.723668357086202707062483341360348315_sp), & + (0.852514651480446872255924972705542983_sp, & + 0.789043817146060844081034701957833041_sp), & + (1.09098446025458177821576555288629603_sp, & + 1.48569478096399141264782883808948111_sp), & + (4.29633077423243321391055360436439499_sp, & + 0.338216396454583145825267820328008412_sp), & + (0.340462754402863337910289942556119029_sp, & + 0.172319442815022222381671213042864120_sp), & (6.932352666201882229746189523211795805E-0002_sp, & 6.742518436285274002761624956292507704E-0002_sp), & - (1.03231628501970258415809666985296648_sp, & - 0.421413014732743429480166241773986277_sp)] + (1.03231628501970258415809666985296648_sp, & + 0.421413014732743429480166241773986277_sp)] print *, "Test exponential_distribution_rvs_csp" seed = 593742186 @@ -189,25 +189,25 @@ subroutine test_expon_rvs_cdp integer :: i, n, k = 5 integer :: seed, get complex(dp) :: ans(10) = [(0.640164505354053137153869101894088070_dp, & - 0.268204995991944639133208738712710328_dp), & + 0.268204995991944639133208738712710328_dp), & (0.141667583643866407117073435983911608_dp, & - 2.60843818343998017361684560455614716_dp), & - (0.116705911955157926040982374615850854_dp, & - 1.04120572522889689448533090398996145_dp), & - (2.06742299986664055388985161698656149_dp, & - 0.723668357086202707062483341360348315_dp), & - (0.852514651480446872255924972705542983_dp, & - 0.789043817146060844081034701957833041_dp), & - (1.09098446025458177821576555288629603_dp, & - 1.48569478096399141264782883808948111_dp), & - (4.29633077423243321391055360436439499_dp, & - 0.338216396454583145825267820328008412_dp), & - (0.340462754402863337910289942556119029_dp, & - 0.172319442815022222381671213042864120_dp), & + 2.60843818343998017361684560455614716_dp), & + (0.116705911955157926040982374615850854_dp, & + 1.04120572522889689448533090398996145_dp), & + (2.06742299986664055388985161698656149_dp, & + 0.723668357086202707062483341360348315_dp), & + (0.852514651480446872255924972705542983_dp, & + 0.789043817146060844081034701957833041_dp), & + (1.09098446025458177821576555288629603_dp, & + 1.48569478096399141264782883808948111_dp), & + (4.29633077423243321391055360436439499_dp, & + 0.338216396454583145825267820328008412_dp), & + (0.340462754402863337910289942556119029_dp, & + 0.172319442815022222381671213042864120_dp), & (6.932352666201882229746189523211795805E-0002_dp, & 6.742518436285274002761624956292507704E-0002_dp), & - (1.03231628501970258415809666985296648_dp, & - 0.421413014732743429480166241773986277_dp)] + (1.03231628501970258415809666985296648_dp, & + 0.421413014732743429480166241773986277_dp)] print *, "Test exponential_distribution_rvs_cdp" seed = 593742186 @@ -226,25 +226,25 @@ subroutine test_expon_rvs_cqp integer :: i, n, k = 5 integer :: seed, get complex(qp) :: ans(10) = [(0.640164505354053137153869101894088070_qp, & - 0.268204995991944639133208738712710328_qp), & + 0.268204995991944639133208738712710328_qp), & (0.141667583643866407117073435983911608_qp, & - 2.60843818343998017361684560455614716_qp), & - (0.116705911955157926040982374615850854_qp, & - 1.04120572522889689448533090398996145_qp), & - (2.06742299986664055388985161698656149_qp, & - 0.723668357086202707062483341360348315_qp), & - (0.852514651480446872255924972705542983_qp, & - 0.789043817146060844081034701957833041_qp), & - (1.09098446025458177821576555288629603_qp, & - 1.48569478096399141264782883808948111_qp), & - (4.29633077423243321391055360436439499_qp, & - 0.338216396454583145825267820328008412_qp), & - (0.340462754402863337910289942556119029_qp, & - 0.172319442815022222381671213042864120_qp), & + 2.60843818343998017361684560455614716_qp), & + (0.116705911955157926040982374615850854_qp, & + 1.04120572522889689448533090398996145_qp), & + (2.06742299986664055388985161698656149_qp, & + 0.723668357086202707062483341360348315_qp), & + (0.852514651480446872255924972705542983_qp, & + 0.789043817146060844081034701957833041_qp), & + (1.09098446025458177821576555288629603_qp, & + 1.48569478096399141264782883808948111_qp), & + (4.29633077423243321391055360436439499_qp, & + 0.338216396454583145825267820328008412_qp), & + (0.340462754402863337910289942556119029_qp, & + 0.172319442815022222381671213042864120_qp), & (6.932352666201882229746189523211795805E-0002_qp, & 6.742518436285274002761624956292507704E-0002_qp), & - (1.03231628501970258415809666985296648_qp, & - 0.421413014732743429480166241773986277_qp)] + (1.03231628501970258415809666985296648_qp, & + 0.421413014732743429480166241773986277_qp)] print *, "Test exponential_distribution_rvs_cqp" seed = 593742186 @@ -335,10 +335,10 @@ subroutine test_expon_pdf_csp integer :: seed, get real :: res(3,5) real :: ans(15) = [0.386471182, 0.386471182,0.386471182,2.79592793E-03, & - 4.01333207E-03, 0.317740440, 0.385551631, & - 5.02163777E-03, 0.372386932, 6.09764457E-03, & - 0.273956627, 0.407586545, 1.59074657E-03, & - 0.136133000, 0.399842113] + 4.01333207E-03, 0.317740440, 0.385551631, & + 5.02163777E-03, 0.372386932, 6.09764457E-03, & + 0.273956627, 0.407586545, 1.59074657E-03, & + 0.136133000, 0.399842113] print *, "Test exponential_distribution_pdf_csp" seed = 123987654 @@ -358,10 +358,10 @@ subroutine test_expon_pdf_cdp integer :: seed, get real :: res(3,5) real :: ans(15) = [0.386471182, 0.386471182,0.386471182,2.79592793E-03, & - 4.01333207E-03, 0.317740440, 0.385551631, & - 5.02163777E-03, 0.372386932, 6.09764457E-03, & - 0.273956627, 0.407586545, 1.59074657E-03, & - 0.136133000, 0.399842113] + 4.01333207E-03, 0.317740440, 0.385551631, & + 5.02163777E-03, 0.372386932, 6.09764457E-03, & + 0.273956627, 0.407586545, 1.59074657E-03, & + 0.136133000, 0.399842113] print *, "Test exponential_distribution_pdf_cdp" seed = 123987654 @@ -381,10 +381,10 @@ subroutine test_expon_pdf_cqp integer :: seed, get real :: res(3,5) real :: ans(15) = [0.386471182, 0.386471182,0.386471182,2.79592793E-03, & - 4.01333207E-03, 0.317740440, 0.385551631, & - 5.02163777E-03, 0.372386932, 6.09764457E-03, & - 0.273956627, 0.407586545, 1.59074657E-03, & - 0.136133000, 0.399842113] + 4.01333207E-03, 0.317740440, 0.385551631, & + 5.02163777E-03, 0.372386932, 6.09764457E-03, & + 0.273956627, 0.407586545, 1.59074657E-03, & + 0.136133000, 0.399842113] print *, "Test exponential_distribution_pdf_cqp" seed = 123987654 @@ -474,9 +474,9 @@ subroutine test_expon_cdf_csp integer :: seed, get real :: res(3,5) real :: ans(15) = [0.176930442, 0.176930442, 0.176930442,5.98644912E-02,& - 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& - 0.118341751, 0.484595388, 0.794088185, 0.912919402, & - 0.914170802, 0.370377690, 0.793968141] + 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& + 0.118341751, 0.484595388, 0.794088185, 0.912919402, & + 0.914170802, 0.370377690, 0.793968141] print *, "Test exponential_distribution_cdf_csp" seed = 621957438 @@ -497,9 +497,9 @@ subroutine test_expon_cdf_cdp integer :: seed, get real :: res(3,5) real :: ans(15) = [0.176930442, 0.176930442, 0.176930442,5.98644912E-02,& - 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& - 0.118341751, 0.484595388, 0.794088185, 0.912919402, & - 0.914170802, 0.370377690, 0.793968141] + 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& + 0.118341751, 0.484595388, 0.794088185, 0.912919402, & + 0.914170802, 0.370377690, 0.793968141] print *, "Test exponential_distribution_cdf_cdp" seed = 621957438 @@ -520,9 +520,9 @@ subroutine test_expon_cdf_cqp integer :: seed, get real :: res(3,5) real :: ans(15) = [0.176930442, 0.176930442, 0.176930442,5.98644912E-02,& - 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& - 0.118341751, 0.484595388, 0.794088185, 0.912919402, & - 0.914170802, 0.370377690, 0.793968141] + 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& + 0.118341751, 0.484595388, 0.794088185, 0.912919402, & + 0.914170802, 0.370377690, 0.793968141] print *, "Test exponential_distribution_cdf_cqp" seed = 621957438 From ac9342caccfb3c980f6b60a97446a4f003b9563c Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Tue, 29 Dec 2020 16:49:37 -0500 Subject: [PATCH 28/55] Update stdlib_stats_distribution_exponential.md --- doc/specs/stdlib_stats_distribution_exponential.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md index 6c8ea4179..ca77242b2 100644 --- a/doc/specs/stdlib_stats_distribution_exponential.md +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -22,6 +22,8 @@ With single argument, the function returns an exponential distributed random var With two auguments the function returns a rank one array of random variates. +The rate parameter `lamda` must be greater than 0. + ### Syntax `result = [[stdlib_stats_distribution_expon(module):exponential_distribution_rvs(interface)]]([lamda] [[, array_size]])` @@ -94,6 +96,8 @@ The probability density function of the continuous exponential distribution. $$ f(x)=\begin{cases}lamda \times e^{-lamda \times x} &x\geqslant 0 \\\\ 0 &x< 0\end{} $$ +x is supported on [0, \infty) + ### Syntax `result = [[stdlib_stats_distribution_expon(module):exponential_distribution_pdf(interface)]](x, lamda)` @@ -166,6 +170,7 @@ Cumulative distribution function of the exponential continuous distribution $$ F(x)=\begin{cases}1 - e^{-lamda \times x} &x\geqslant 0 \\\\ 0 &x< 0\end{} $$ +x is supported on [0, \infty) ### Syntax From 7eb2c463096f25ce82db29e83d3f594ee17a1d2a Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Tue, 29 Dec 2020 17:44:09 -0500 Subject: [PATCH 29/55] Update Makefile.manual --- src/Makefile.manual | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 09b9af835..05ca095cb 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -14,7 +14,9 @@ SRC = f18estop.f90 \ stdlib_quadrature_trapz.f90 \ stdlib_stats.f90 \ stdlib_stats_mean.f90 \ - stdlib_stats_moment.f90 \ + stdlib_stats_moment_all.f90 \ + stdlib_stats_moment_mask.f90 \ + stdlib_stats_moment_scalar.f90 \ stdlib_stats_var.f90 \ stdlib_stats_distribution_PRNG.f90 \ stdlib_stats_distribution_uniform.f90 \ From e484595e28bca443816b7ff1f584f713986ebcc9 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Tue, 29 Dec 2020 17:48:03 -0500 Subject: [PATCH 30/55] Update Makefile.manual --- src/Makefile.manual | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Makefile.manual b/src/Makefile.manual index 05ca095cb..416c7d6e3 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -14,6 +14,7 @@ SRC = f18estop.f90 \ stdlib_quadrature_trapz.f90 \ stdlib_stats.f90 \ stdlib_stats_mean.f90 \ + stdlib_stats_moment.f90 \ stdlib_stats_moment_all.f90 \ stdlib_stats_moment_mask.f90 \ stdlib_stats_moment_scalar.f90 \ From aa81a503c43698435db96190e0b66c0dbb8c7c4d Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 31 Dec 2020 15:21:49 -0500 Subject: [PATCH 31/55] Update CMakeLists.txt --- src/CMakeLists.txt | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3b787b0cc..f17389d56 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -18,9 +18,7 @@ set(fppFiles stdlib_quadrature.fypp stdlib_quadrature_trapz.fypp stdlib_quadrature_simps.fypp - stdlib_stats_distribution_PRNG.fypp - stdlib_stats_distribution_uniform.fypp - stdlib_stats_distribution_exponential.fypp + ) From 4062389ab84b4dff8d9b0e35546bb5cd25b69f0b Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 31 Dec 2020 15:22:34 -0500 Subject: [PATCH 32/55] Update Makefile.manual --- src/Makefile.manual | 18 +----------------- 1 file changed, 1 insertion(+), 17 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 416c7d6e3..5112adb3e 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -18,10 +18,7 @@ SRC = f18estop.f90 \ stdlib_stats_moment_all.f90 \ stdlib_stats_moment_mask.f90 \ stdlib_stats_moment_scalar.f90 \ - stdlib_stats_var.f90 \ - stdlib_stats_distribution_PRNG.f90 \ - stdlib_stats_distribution_uniform.f90 \ - stdlib_stats_distribution_exponential.f90 + stdlib_stats_var.f90 LIB = libstdlib.a @@ -73,16 +70,6 @@ stdlib_stats_var.o: \ stdlib_optval.o \ stdlib_kinds.o \ stdlib_stats.o -stdlib_stats_distribution_PRNG.o: stdlib_kinds.o -stdlib_stats_distribution_uniform.o: \ - stdlib_kinds.o \ - stdlib_error.o \ - stdlib_stats_distribution_PRNG.o -stdlib_stats_distribution_exponential.o: \ - stdlib_kinds.o \ - stdlib_error.o \ - stdlib_stats_distribution_PRNG.o \ - stdlib_stats_distribution_uniform.o # Fortran sources that are built from fypp templates stdlib_bitsets_64.f90: stdlib_bitsets_64.fypp @@ -96,6 +83,3 @@ stdlib_stats.f90: stdlib_stats.fypp stdlib_stats_mean.f90: stdlib_stats_mean.fypp stdlib_stats_moment.f90: stdlib_stats_moment.fypp stdlib_stats_var.f90: stdlib_stats_var.fypp -stdlib_stats_distribution_PRNG.f90: stdlib_stats_distribution_PRNG.fypp -stdlib_stats_distribution_uniform.f90: stdlib_stats_distribution_uniform.fypp -stdlib_stats_distribution_exponential.f90: stdlib_stats_distribution_exponential.fypp From cf10419c687e35ce9970e2aa658e0a61c8ad8bbd Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 31 Dec 2020 15:23:42 -0500 Subject: [PATCH 33/55] Update Makefile.manual --- src/Makefile.manual | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 5112adb3e..8b54c2144 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -19,7 +19,7 @@ SRC = f18estop.f90 \ stdlib_stats_moment_mask.f90 \ stdlib_stats_moment_scalar.f90 \ stdlib_stats_var.f90 - + LIB = libstdlib.a @@ -70,7 +70,7 @@ stdlib_stats_var.o: \ stdlib_optval.o \ stdlib_kinds.o \ stdlib_stats.o - + # Fortran sources that are built from fypp templates stdlib_bitsets_64.f90: stdlib_bitsets_64.fypp stdlib_bitsets_large.f90: stdlib_bitsets_large.fypp From b590e796f453a6229e35c0596d8aec4eb0af1141 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 31 Dec 2020 15:25:43 -0500 Subject: [PATCH 34/55] Update Makefile.manual --- src/Makefile.manual | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/Makefile.manual b/src/Makefile.manual index dd6f12708..93e56dc2a 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -70,6 +70,16 @@ stdlib_stats_var.o: \ stdlib_optval.o \ stdlib_kinds.o \ stdlib_stats.o +stdlib_stats_distribution_PRNG.o: stdlib_kinds.o +stdlib_stats_distribution_uniform.o: \ + stdlib_kinds.o \ + stdlib_error.o \ + stdlib_stats_distribution_PRNG.o +stdlib_stats_distribution_exponential.o: \ + stdlib_kinds.o \ + stdlib_error.o \ + stdlib_stats_distribution_PRNG.o \ + stdlib_stats_distribution_uniform.o # Fortran sources that are built from fypp templates stdlib_bitsets_64.f90: stdlib_bitsets_64.fypp @@ -86,3 +96,6 @@ stdlib_stats_moment_all.f90: stdlib_stats_moment_all.fypp stdlib_stats_moment_mask.f90: stdlib_stats_moment_mask.fypp stdlib_stats_moment_scalar.f90: stdlib_stats_moment_scalar.fypp stdlib_stats_var.f90: stdlib_stats_var.fypp +stdlib_stats_distribution_PRNG.f90: stdlib_stats_distribution_PRNG.fypp +stdlib_stats_distribution_uniform.f90: stdlib_stats_distribution_uniform.fypp +stdlib_stats_distribution_exponential.f90: stdlib_stats_distribution_exponential.fypp From 4cd7866aa5b1f70ffc08dcc15b513e5421887e1a Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 31 Dec 2020 15:26:42 -0500 Subject: [PATCH 35/55] Update CMakeLists.txt --- src/CMakeLists.txt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 1704e12ab..2b9dd6e99 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -21,6 +21,9 @@ set(fppFiles stdlib_quadrature.fypp stdlib_quadrature_trapz.fypp stdlib_quadrature_simps.fypp + stdlib_stats_distribution_PRNG.fypp + stdlib_stats_distribution_uniform.fypp + stdlib_stats_distribution_exponential.fypp ) From 93b0fc43725218cfd9b2cd9e69679da3f06588a6 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 31 Dec 2020 18:40:47 -0500 Subject: [PATCH 36/55] Update Makefile.manual --- src/Makefile.manual | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 93e56dc2a..9f3d27852 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -18,7 +18,10 @@ SRC = f18estop.f90 \ stdlib_stats_moment_all.f90 \ stdlib_stats_moment_mask.f90 \ stdlib_stats_moment_scalar.f90 \ - stdlib_stats_var.f90 + stdlib_stats_var.f90 \ + stdlib_stats_distribution_PRNG.f90 \ + stdlib_stats_distribution_uniform.f90 \ + stdlib_stats_distribution_exponential.f90 LIB = libstdlib.a From b53a2705fa48d29d3de8e80f75aba387c0cc03e7 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 21 Jan 2021 20:11:22 -0500 Subject: [PATCH 37/55] Add files via upload --- .../stdlib_stats_distribution_exponential.md | 87 +++++++++---------- 1 file changed, 43 insertions(+), 44 deletions(-) diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md index ca77242b2..d9e3d4f5e 100644 --- a/doc/specs/stdlib_stats_distribution_exponential.md +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -2,7 +2,7 @@ title: stats_distribution --- -# Statistical Distributions -- Exponential Distribution Module +# Statistical Distributions -- Exponential Module [TOC] @@ -22,33 +22,31 @@ With single argument, the function returns an exponential distributed random var With two auguments the function returns a rank one array of random variates. -The rate parameter `lamda` must be greater than 0. - ### Syntax -`result = [[stdlib_stats_distribution_expon(module):exponential_distribution_rvs(interface)]]([lamda] [[, array_size]])` +`result = [[stdlib_stats_distribution_exponential(module):exponential_distribution_rvs(interface)]]([lamda] [[, array_size]])` ### Arguments -`lamda`: optional argument has `intent(in)` and is a scalar of type `real` or `complx`. +`lamda`: optional argument has `intent(in)` and is a scalar of type `real` or `complex`. `array_size`: optional argument has `intent(in)` and is a scalar of type `integer`. ### Return value -The result is a scalar or rank one array, with a size of `array_size`, of type `real` or `complx`. +The result is a scalar or rank one array, with a size of `array_size`, of type `real` or `complex`. ### Example ```fortran program demo_exponential_rvs use stdlib_stats_distribution_PRNG, only : random_seed - use stdlib_stats_distribution_expon, only: & - rexp => exponential_distribution_rvs + use stdlib_stats_distribution_exponential, only: & + rexp => exponential_distribution_rvs implicit none real :: a(2,3,4) - complx :: scale + complex :: scale integer :: seed_put, seed_get seed_put = 1234567 @@ -64,20 +62,22 @@ program demo_exponential_rvs print *, rexp(0.3, 10) !an array of 10 variates with lamda=0.3 -! [1.84008647E-02, 3.59742008E-02, 0.136567295, 0.262772143, 3.62352766E-02, -! 0.547133625, 0.213591918, 4.10784185E-02, 0.583882213, 0.671128035] +! 1.84008647E-02 3.59742008E-02 0.136567295 0.262772143 3.62352766E-02 +! 0.547133625 0.213591918 4.10784185E-02 0.583882213 0.671128035 a(:,:,:) = 0.5 print *, rexp(a) !a rank 3 array of 24 exponential random variates -! [0.219550118, 0.318272740, 0.426896989, 0.803026378, 0.395067871, -! 5.93891777E-02, 0.809226036, 1.27890170, 1.38805652, 0.179149821, -! 1.75288841E-02, 7.23171830E-02, 0.157068044, 0.153069839, 0.421180248, -! 0.517792642, 2.09411430, 0.785641313, 0.116311245, 0.295113146, -! 0.824005902, 0.123385273, 5.50238751E-02, 3.52851897E-02] +! 0.219550118 0.318272740 0.426896989 0.803026378 0.395067871 +! 5.93891777E-02 0.809226036 1.27890170 1.38805652 0.179149821 +! 1.75288841E-02 7.23171830E-02 0.157068044 0.153069839 0.421180248 +! 0.517792642 2.09411430 0.785641313 0.116311245 0.295113146 +! 0.824005902 0.123385273 5.50238751E-02 3.52851897E-02 scale = (2.0, 0.7) - print *, rexp(scale) !single complex exponential random variate with real part of lamda=2.0; imagainary part of lamda=0.7 + print *, rexp(scale) + !single complex exponential random variate with real part of lamda=2.0; + !imagainary part of lamda=0.7 ! (1.41435969,4.081114382E-02) @@ -96,17 +96,15 @@ The probability density function of the continuous exponential distribution. $$ f(x)=\begin{cases}lamda \times e^{-lamda \times x} &x\geqslant 0 \\\\ 0 &x< 0\end{} $$ -x is supported on [0, \infty) - ### Syntax -`result = [[stdlib_stats_distribution_expon(module):exponential_distribution_pdf(interface)]](x, lamda)` +`result = [[stdlib_stats_distribution_exponential(module):exponential_distribution_pdf(interface)]](x, lamda)` ### Arguments -`x`: has `intent(in)` and is a scalar of type `real` or `complx`. +`x`: has `intent(in)` and is a scalar of type `real` or `complex`. -`lamda`: has `intent(in)` and is a scalar of type `real` or `complx`. +`lamda`: has `intent(in)` and is a scalar of type `real` or `complex`. The function is elemental, i.e., all auguments could be arrays conformable to each other. All arguments must have the same type. @@ -119,13 +117,13 @@ The result is a scalar or an array, with a shape conformable to auguments, of ty ```fortran program demo_exponential_pdf use stdlib_stats_distribution_PRNG, only : random_seed - use stdlib_stats_distribution_expon, only : & - exp_pdf => exponential_distribution_pdf, & - rexp => exponential_distribution_rvs + use stdlib_stats_distribution_exponential, only: & + exp_pdf => exponential_distribution_pdf, & + rexp => exponential_distribution_rvs implicit none real :: x(2,3,4),a(2,3,4) - complx :: scale + complex :: scale integer :: seed_put, seed_get seed_put = 1234567 @@ -143,15 +141,16 @@ program demo_exponential_pdf a(:,:,:) = 0.5 print *, exp_pdf(x, a) ! a rank 3 standard expon probability density -! [0.457115263, 0.451488823, 0.492391467, 0.485233188, 0.446215510, -! 0.401670188, 0.485127628, 0.316924453, 0.418474048, 0.483173639, -! 0.307366133, 0.285812140, 0.448017836, 0.426440030, 0.403896868, -! 0.334653258, 0.410376132, 0.485370994, 0.333617479, 0.263791025, -! 0.249779820, 0.457159877, 0.495636940, 0.482243657] +! 0.457115263 0.451488823 0.492391467 0.485233188 0.446215510 +! 0.401670188 0.485127628 0.316924453 0.418474048 0.483173639 +! 0.307366133 0.285812140 0.448017836 0.426440030 0.403896868 +! 0.334653258 0.410376132 0.485370994 0.333617479 0.263791025 +! 0.249779820 0.457159877 0.495636940 0.482243657 scale = (1.0, 2.) print *, exp_pdf((1.5,1.0), scale) - ! a complex expon probability density function at (1.5,1.0) with real part of lamda=1.0 and imaginary part of lamda=2.0 + ! a complex expon probability density function at (1.5,1.0) with real part + !of lamda=1.0 and imaginary part of lamda=2.0 ! 6.03947677E-02 @@ -170,17 +169,16 @@ Cumulative distribution function of the exponential continuous distribution $$ F(x)=\begin{cases}1 - e^{-lamda \times x} &x\geqslant 0 \\\\ 0 &x< 0\end{} $$ -x is supported on [0, \infty) ### Syntax -`result = [[stdlib_stats_distribution_expon(module):exponential_distribution_cdf(interface)]](x, lamda)` +`result = [[stdlib_stats_distribution_exponential(module):exponential_distribution_cdf(interface)]](x, lamda)` ### Arguments -`x`: has `intent(in)` and is a scalar of type `real` or `complx`. +`x`: has `intent(in)` and is a scalar of type `real` or `complex`. -`lamda`: has `intent(in)` and is a scalar of type `real` or `complx`. +`lamda`: has `intent(in)` and is a scalar of type `real` or `complex`. The function is elemental, i.e., all auguments could be arrays conformable to each other. All arguments must have the same type. @@ -193,13 +191,13 @@ The result is a scalar or an array, with a shape conformable to auguments, of ty ```fortran program demo_exponential_cdf use stdlib_stats_distribution_PRNG, only : random_seed - use stdlib_stats_distribution_expon, only : & + use stdlib_stats_distribution_exponential, only : & exp_cdf => exponential_distribution_cdf, & rexp => exponential_distribution_rvs implicit none real :: x(2,3,4),a(2,3,4) - complx :: scale + complex :: scale integer :: seed_put, seed_get seed_put = 1234567 @@ -218,15 +216,16 @@ program demo_exponential_cdf a(:,:,:) = 0.5 print *, exp_cdf(x, a) ! a rank 3 array of standard exponential cumulative -! [8.57694745E-02, 9.70223546E-02, 1.52170658E-02, 2.95336246E-02, -! 0.107568979, 0.196659625, 2.97447443E-02, 0.366151094, 0.163051903, -! 3.36527228E-02, 0.385267735, 0.428375721, 0.103964329, 0.147119939, -! 0.192206264, 0.330693483, 0.179247737, 2.92580128E-02, 0.332765043, -! 0.472417951, 0.500440359, 8.56802464E-02, 8.72612000E-03, 3.55126858E-02] +! 8.57694745E-02 9.70223546E-02 1.52170658E-02 2.95336246E-02 +! 0.107568979 0.196659625 2.97447443E-02 0.366151094 0.163051903 +! 3.36527228E-02 0.385267735 0.428375721 0.103964329 0.147119939 +! 0.192206264 0.330693483 0.179247737 2.92580128E-02 0.332765043 +! 0.472417951 0.500440359 8.56802464E-02 8.72612000E-03 3.55126858E-02 scale = (0.5,1.0) print *, exp_cdf((0.5,0.5),scale) - !complex exponential cumulative distribution at (0.5,0.5) with real part of lamda=0.5 and imaginary part of lamda=1.0 + !complex exponential cumulative distribution at (0.5,0.5) with real part of + !lamda=0.5 and imaginary part of lamda=1.0 ! 8.70351046E-02 From fe9aea41ca7cb33d54148c28fa2f5973e594cb20 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 21 Jan 2021 20:12:04 -0500 Subject: [PATCH 38/55] Add files via upload --- src/stdlib_stats_distribution_PRNG.fypp | 75 ++----------------- ...stdlib_stats_distribution_exponential.fypp | 30 ++++---- src/stdlib_stats_distribution_uniform.fypp | 46 ++++++------ 3 files changed, 48 insertions(+), 103 deletions(-) diff --git a/src/stdlib_stats_distribution_PRNG.fypp b/src/stdlib_stats_distribution_PRNG.fypp index d1bda107a..3fdbf0438 100644 --- a/src/stdlib_stats_distribution_PRNG.fypp +++ b/src/stdlib_stats_distribution_PRNG.fypp @@ -1,16 +1,16 @@ #:include "common.fypp" module stdlib_stats_distribution_PRNG use stdlib_kinds, only: int8, int16, int32, int64 + use stdlib_error implicit none private integer, parameter :: MAX_INT_BIT_SIZE = bit_size(1_int64) - integer(int64), save :: st(4), si = 614872703977525537_int64 + integer(int64), save :: st(4) ! internal states for xoshiro256ss function + integer(int64), save :: si = 614872703977525537_int64 ! default seed value logical, save :: seed_initialized = .false. public :: random_seed public :: dist_rand - public :: jump - public :: long_jump interface dist_rand @@ -51,6 +51,8 @@ module stdlib_stats_distribution_PRNG integer :: k k = MAX_INT_BIT_SIZE - bit_size(n) + if(k < 0) call error_stop("Error(dist_rand): Integer bit size is" & + //" greater than 64bit") res = shiftr(xoshiro256ss( ), k) end function dist_rand_${t1[0]}$${k1}$ @@ -96,71 +98,6 @@ module stdlib_stats_distribution_PRNG end function rol64 - subroutine jump - ! This is the jump function for the xoshiro256ss generator. It is equivalent - ! to 2^128 calls to xoshiro256ss(); it can be used to generate 2^128 - ! non-overlapping subsequences for parallel computations. - ! Written in 2018 by David Blackman and Sebastiano Vigna (vigna@acm.org) - ! http://prng.di.unimi.it/xoshiro256starstar.c - ! - ! Fortran 90 version translated from C by Jim-215-Fisher - integer(int64) :: jp(4) = [1733541517147835066_int64, & - -3051731464161248980_int64, & - -6244198995065845334_int64, & - 4155657270789760540_int64] - integer(int64) :: s1 = 0, s2 = 0, s3 = 0, s4 = 0, c = 1_int64 - integer :: i, j, k - - do i = 1, 4 - do j = 1, 64 - if(iand(jp(i), shiftl(c, j - 1)) /= 0) then - s1 = ieor(s1, st(1)) - s2 = ieor(s2, st(2)) - s3 = ieor(s3, st(3)) - s4 = ieor(s4, st(4)) - end if - k = xoshiro256ss( ) - end do - end do - st(1) = s1 - st(2) = s2 - st(3) = s3 - st(4) = s4 - end subroutine jump - - subroutine long_jump - ! This is the long-jump function for the xoshiro256ss generator. It is - ! equivalent to 2^192 calls to xoshiro256ss(); it can be used to generate - ! 2^64 starting points, from each of which jump() will generate 2^64 - ! non-overlapping subsequences for parallel distributed computations - ! Written in 2018 by David Blackman and Sebastiano Vigna (vigna@acm.org) - ! http://prng.di.unimi.it/xoshiro256starstar.c - ! - ! Fortran 90 version translated from C by Jim-215-Fisher - integer(int64) :: jp(4) = [8566230491382795199_int64, & - -4251311993797857357_int64, & - 8606660816089834049_int64, & - 4111957640723818037_int64] - integer(int64) :: s1 = 0, s2 = 0, s3 = 0, s4 = 0, c = 1_int64 - integer(int32) :: i, j, k - - do i = 1, 4 - do j = 1, 64 - if(iand(jp(i), shiftl(c, j - 1)) /= 0) then - s1 = ieor(s1, st(1)) - s2 = ieor(s2, st(2)) - s3 = ieor(s3, st(3)) - s4 = ieor(s4, st(4)) - end if - k = xoshiro256ss() - end do - end do - st(1) = s1 - st(2) = s2 - st(3) = s3 - st(4) = s4 - end subroutine long_jump - function splitmix64(s) result(res) ! Written in 2015 by Sebastiano Vigna (vigna@acm.org) ! This is a fixed-increment version of Java 8's SplittableRandom @@ -178,6 +115,8 @@ module stdlib_stats_distribution_PRNG data int01, int02, int03/-7046029254386353131_int64, & -4658895280553007687_int64, & -7723592293110705685_int64/ + ! Values are converted from C unsigned integer of 0x9e3779b97f4a7c15, + ! 0xbf58476d1ce4e5b9, 0x94d049bb133111eb if(present(s)) si = s res = si diff --git a/src/stdlib_stats_distribution_exponential.fypp b/src/stdlib_stats_distribution_exponential.fypp index 059865865..750170939 100644 --- a/src/stdlib_stats_distribution_exponential.fypp +++ b/src/stdlib_stats_distribution_exponential.fypp @@ -1,6 +1,6 @@ #:include "common.fypp" #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES -Module stdlib_stats_distribution_expon +Module stdlib_stats_distribution_exponential use stdlib_kinds use stdlib_error, only : error_stop use stdlib_stats_distribution_PRNG, only : dist_rand @@ -157,8 +157,9 @@ Module stdlib_stats_distribution_expon ${t1}$ :: r = 7.69711747013104972_${k1}$ integer(int32) :: jz, iz - if(lamda <= 0.0_${k1}$) call error_stop("Error: Exponential" & - //" distribution lamda parameter must be greaeter than zero") + if(lamda <= 0.0_${k1}$) call error_stop("Error(exp_dist_rvs):" & + //" Exponential distribution lamda parameter must be greater than zero") + if( .not. zig_exp_initialized ) call zigset ! Original algorithm use 32bit @@ -218,8 +219,9 @@ Module stdlib_stats_distribution_expon ${t1}$ :: r = 7.69711747013104972_${k1}$ integer :: jz, iz, i - if(lamda <= 0.0_${k1}$) call error_stop("Error: Exponential" & - //" distribution lamda parameter must be greaeter than zero") + if(lamda <= 0.0_${k1}$) call error_stop("Error(exp_dist_rvs_array):" & + //" Exponential distribution lamda parameter must be greater than zero") + if( .not. zig_exp_initialized ) call zigset allocate(res(array_size)) do i =1, array_size @@ -284,10 +286,10 @@ Module stdlib_stats_distribution_expon ${t1}$, intent(in) :: x, lamda real :: res - if(lamda <= 0.0_${k1}$) call error_stop("Error: Exponential" & - //" distribution lamda parameter must be greaeter than zero") - if(x < 0.0_${k1}$) call error_stop("Error: Exponential distribution" & - //" variate x must be non-negative") + if(lamda <= 0.0_${k1}$) call error_stop("Error(exp_dist_pdf):" & + //" Exponential distribution lamda parameter must be greater than zero") + if(x < 0.0_${k1}$) call error_stop("Error(exp_dist_pdf): Exponential" & + //" distribution variate x must be non-negative") res = exp(- x * lamda) * lamda return end function exp_dist_pdf_${t1[0]}$${k1}$ @@ -313,10 +315,10 @@ Module stdlib_stats_distribution_expon ${t1}$, intent(in) :: x, lamda real :: res - if(lamda <= 0.0_${k1}$) call error_stop("Error: Exponential" & - //" distribution lamda parameter must be greaeter than zero") - if(x < 0.0_${k1}$) call error_stop("Error: Exponential distribution" & - //" variate x must be non-negative") + if(lamda <= 0.0_${k1}$) call error_stop("Error(exp_dist_cdf):" & + //" Exponential distribution lamda parameter must be greater than zero") + if(x < 0.0_${k1}$) call error_stop("Error(exp_dist_cdf): Exponential" & + //" distribution variate x must be non-negative") res = (1.0 - exp(- x * lamda)) return end function exp_dist_cdf_${t1[0]}$${k1}$ @@ -334,4 +336,4 @@ Module stdlib_stats_distribution_expon end function exp_dist_cdf_${t1[0]}$${k1}$ #:endfor -end module stdlib_stats_distribution_expon \ No newline at end of file +end module stdlib_stats_distribution_exponential \ No newline at end of file diff --git a/src/stdlib_stats_distribution_uniform.fypp b/src/stdlib_stats_distribution_uniform.fypp index 572caaf37..b538144f8 100644 --- a/src/stdlib_stats_distribution_uniform.fypp +++ b/src/stdlib_stats_distribution_uniform.fypp @@ -42,7 +42,8 @@ Module stdlib_stats_distribution_uniform interface uniform_distribution_pdf !! Version experiment !! - !! Get uniform distribution probability density (pdf) for integer, real and complex variables + !! Get uniform distribution probability density (pdf) for integer, real and + !! complex variables !! ([Specification](../page/specs/stdlib_stats_distribution_uniform.html# !! description)) @@ -54,7 +55,8 @@ Module stdlib_stats_distribution_uniform interface uniform_distribution_cdf !! Version experimental !! - !! Get uniform distribution cumulative distribution function (cdf) for integer, real and complex variables + !! Get uniform distribution cumulative distribution function (cdf) for + !! integer, real and complex variables !! ([Specification](../page/specs/stdlib_stats_distribution_uniform.html# !! description)) !! @@ -66,7 +68,8 @@ Module stdlib_stats_distribution_uniform interface shuffle !! Version experimental !! - !! Fisher-Yates shuffle algorithm for a rank one array of integer, real and complex variables + !! Fisher-Yates shuffle algorithm for a rank one array of integer, real and + !! complex variables !! ([Specification](../page/specs/stdlib_stats_distribution_uniform.html# !! description)) !! @@ -85,13 +88,14 @@ Module stdlib_stats_distribution_uniform ! https://www.pcg-random.org/posts/bounded-rands.html ! ! Fortran 90 translated from c by Jim-215-fisher + ! ${t1}$, intent(in) :: scale ${t1}$ :: res, u, mask, n integer :: zeros, bits_left, bits n = scale - if(n <= 0_${k1}$) call error_stop("Error: Uniform distribution scale" & - //" parameter must be positive") + if(n <= 0_${k1}$) call error_stop("Error(unif_dist_rvs_1): Uniform" & + //" distribution scale parameter must be positive") zeros = leadz(n) bits = bit_size(n) - zeros mask = shiftr(not(0_${k1}$), zeros) @@ -121,8 +125,8 @@ Module stdlib_stats_distribution_uniform ${t1}$, intent(in) :: loc, scale ${t1}$ :: res - if(scale == 0_${k1}$) call error_stop("Error: Uniform distribution" & - //" scale parameter must be non-zero") + if(scale <= 0_${k1}$) call error_stop("Error(unif_dist_rvs): Uniform" & + //" distribution scale parameter must be positive") res = loc + unif_dist_rvs_1_${t1[0]}$${k1}$(scale) return end function unif_dist_rvs_${t1[0]}$${k1}$ @@ -153,8 +157,8 @@ Module stdlib_stats_distribution_uniform ${t1}$, intent(in) :: scale ${t1}$ :: res - if(scale == 0._${k1}$) call error_stop("Error: Uniform distribution" & - //" scale parameter must be non-zero") + if(scale == 0._${k1}$) call error_stop("Error(unif_dist_rvs_1): " & + //"Uniform distribution scale parameter must be non-zero") res = scale * unif_dist_rvs_0_${t1[0]}$${k1}$( ) return end function unif_dist_rvs_1_${t1[0]}$${k1}$ @@ -169,8 +173,8 @@ Module stdlib_stats_distribution_uniform ${t1}$, intent(in) :: loc, scale ${t1}$ :: res - if(scale == 0._${k1}$) call error_stop("Error: Uniform distribution" & - //" scale parameter must be non-zero") + if(scale == 0._${k1}$) call error_stop("Error(unif_dist_rvs): " & + //"Uniform distribution scale parameter must be non-zero") res = loc + scale * unif_dist_rvs_0_${t1[0]}$${k1}$( ) return end function unif_dist_rvs_${t1[0]}$${k1}$ @@ -187,8 +191,8 @@ Module stdlib_stats_distribution_uniform ${t1}$ :: res real(${k1}$) :: r1, r2, tr, ti - if(scale == (0.0_${k1}$, 0.0_${k1}$)) call error_stop("Error: Uniform" & - //" distribution scale parameter must be non-zero") + if(scale == (0.0_${k1}$, 0.0_${k1}$)) call error_stop("Error(uni_dist_" & + //"rvs_1): Uniform distribution scale parameter must be non-zero") r1 = unif_dist_rvs_0_r${k1}$( ) if(real(scale) == 0.0_${k1}$) then ti = aimag(scale) * r1 @@ -219,8 +223,8 @@ Module stdlib_stats_distribution_uniform ${t1}$ :: res real(${k1}$) :: r1, r2, tr, ti - if(scale == (0.0_${k1}$, 0.0_${k1}$)) call error_stop("Error: Uniform" & - //" distribution scale parameter must be non-zero") + if(scale == (0.0_${k1}$, 0.0_${k1}$)) call error_stop("Error(uni_dist_" & + //"rvs): Uniform distribution scale parameter must be non-zero") r1 = unif_dist_rvs_0_r${k1}$( ) if(real(scale) == 0.0_${k1}$) then tr = real(loc) @@ -249,8 +253,8 @@ Module stdlib_stats_distribution_uniform integer :: i, zeros, bits_left, bits n = scale - if(n == 0_${k1}$) call error_stop("Error: Uniform distribution" & - //" scale parameter must be non-zero") + if(n == 0_${k1}$) call error_stop("Error(unif_dist_rvs_array): Uniform" & + //" distribution scale parameter must be non-zero") allocate(res(array_size)) zeros = leadz(n) bits = bit_size(n) - zeros @@ -287,8 +291,8 @@ Module stdlib_stats_distribution_uniform integer :: i - if(scale == 0._${k1}$) call error_stop("Error: Uniform distribution" & - //" scale parameter must be non-zero") + if(scale == 0._${k1}$) call error_stop("Error(unif_dist_rvs_array):" & + //" Uniform distribution scale parameter must be non-zero") allocate(res(array_size)) do i = 1, array_size tmp = shiftr(dist_rand(INT_ONE), 11) @@ -311,8 +315,8 @@ Module stdlib_stats_distribution_uniform integer :: i - if(scale == (0.0_${k1}$, 0.0_${k1}$)) call error_stop("Error: Uniform" & - //" distribution scale parameter must be non-zero") + if(scale == (0.0_${k1}$, 0.0_${k1}$)) call error_stop("Error(unif_dist_"& + //"rvs_array): Uniform distribution scale parameter must be non-zero") allocate(res(array_size)) do i = 1, array_size tmp = shiftr(dist_rand(INT_ONE), 11) From 47cd8f3990480ac5b9fe108dedd283541156448d Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 21 Jan 2021 20:13:50 -0500 Subject: [PATCH 39/55] Update Makefile.manual --- src/Makefile.manual | 106 ++++++++++++++++++++++---------------------- 1 file changed, 54 insertions(+), 52 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 9f3d27852..9351a374a 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -1,32 +1,35 @@ +SRCFYPP =\ + stdlib_bitsets_64.fypp \ + stdlib_bitsets_large.fypp \ + stdlib_bitsets.fypp \ + stdlib_io.fypp \ + stdlib_linalg.fypp \ + stdlib_linalg_diag.fypp \ + stdlib_optval.fypp \ + stdlib_quadrature.fypp \ + stdlib_quadrature_trapz.fypp \ + stdlib_quadrature_simps.fypp \ + stdlib_stats.fypp \ + stdlib_stats_corr.fypp \ + stdlib_stats_cov.fypp \ + stdlib_stats_mean.fypp \ + stdlib_stats_moment.fypp \ + stdlib_stats_moment_all.fypp \ + stdlib_stats_moment_mask.fypp \ + stdlib_stats_moment_scalar.fypp \ + stdlib_stats_var.fypp + SRC = f18estop.f90 \ stdlib_ascii.f90 \ - stdlib_bitsets.f90 \ - stdlib_bitsets_64.f90 \ - stdlib_bitsets_large.f90 \ stdlib_error.f90 \ - stdlib_io.f90 \ stdlib_kinds.f90 \ - stdlib_linalg.f90 \ - stdlib_linalg_diag.f90 \ stdlib_logger.f90 \ - stdlib_optval.f90 \ - stdlib_quadrature.f90 \ - stdlib_quadrature_trapz.f90 \ - stdlib_stats.f90 \ - stdlib_stats_mean.f90 \ - stdlib_stats_moment.f90 \ - stdlib_stats_moment_all.f90 \ - stdlib_stats_moment_mask.f90 \ - stdlib_stats_moment_scalar.f90 \ - stdlib_stats_var.f90 \ - stdlib_stats_distribution_PRNG.f90 \ - stdlib_stats_distribution_uniform.f90 \ - stdlib_stats_distribution_exponential.f90 + $(SRCGEN) LIB = libstdlib.a - +SRCGEN = $(SRCFYPP:.fypp=.f90) OBJS = $(SRC:.f90=.o) MODS = $(OBJS:.o=.mod) SMODS = $(OBJS:.o=*.smod) @@ -39,12 +42,12 @@ $(LIB): $(OBJS) ar rcs $@ $(OBJS) clean: - $(RM) $(LIB) $(OBJS) $(MODS) $(SMODS) + $(RM) $(LIB) $(OBJS) $(MODS) $(SMODS) $(SRCGEN) %.o: %.f90 $(FC) $(FFLAGS) -c $< -%.f90: %.fypp +$(SRCGEN): %.f90: %.fypp common.fypp fypp $(FYPPFLAGS) $< $@ # Fortran module dependencies @@ -57,10 +60,32 @@ stdlib_io.o: \ stdlib_error.o \ stdlib_optval.o \ stdlib_kinds.o -stdlib_linalg_diag.o: stdlib_kinds.o +stdlib_linalg.o: \ + stdlib_kinds.o +stdlib_linalg_diag.o: \ + stdlib_linalg.o \ + stdlib_kinds.o stdlib_logger.o: stdlib_ascii.o stdlib_optval.o stdlib_optval.o: stdlib_kinds.o stdlib_quadrature.o: stdlib_kinds.o +stdlib_quadrature_simps.o: \ + stdlib_quadrature.o \ + stdlib_error.o \ + stdlib_kinds.o +stdlib_quadrature_trapz.o: \ + stdlib_quadrature.o \ + stdlib_error.o \ + stdlib_kinds.o +stdlib_stats.o: \ + stdlib_kinds.o +stdlib_stats_corr.o: \ + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o +stdlib_stats_cov.o: \ + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o stdlib_stats_mean.o: \ stdlib_optval.o \ stdlib_kinds.o \ @@ -69,36 +94,13 @@ stdlib_stats_moment.o: \ stdlib_optval.o \ stdlib_kinds.o \ stdlib_stats.o +stdlib_stats_moment_all.o: \ + stdlib_stats_moment.o +stdlib_stats_moment_mask.o: \ + stdlib_stats_moment.o +stdlib_stats_moment_scalar.o: \ + stdlib_stats_moment.o stdlib_stats_var.o: \ stdlib_optval.o \ stdlib_kinds.o \ stdlib_stats.o -stdlib_stats_distribution_PRNG.o: stdlib_kinds.o -stdlib_stats_distribution_uniform.o: \ - stdlib_kinds.o \ - stdlib_error.o \ - stdlib_stats_distribution_PRNG.o -stdlib_stats_distribution_exponential.o: \ - stdlib_kinds.o \ - stdlib_error.o \ - stdlib_stats_distribution_PRNG.o \ - stdlib_stats_distribution_uniform.o - -# Fortran sources that are built from fypp templates -stdlib_bitsets_64.f90: stdlib_bitsets_64.fypp -stdlib_bitsets_large.f90: stdlib_bitsets_large.fypp -stdlib_bitsets.f90: stdlib_bitsets.fypp -stdlib_io.f90: stdlib_io.fypp -stdlib_linalg.f90: stdlib_linalg.fypp -stdlib_linalg_diag.f90: stdlib_linalg_diag.fypp -stdlib_quadrature.f90: stdlib_quadrature.fypp -stdlib_stats.f90: stdlib_stats.fypp -stdlib_stats_mean.f90: stdlib_stats_mean.fypp -stdlib_stats_moment.f90: stdlib_stats_moment.fypp -stdlib_stats_moment_all.f90: stdlib_stats_moment_all.fypp -stdlib_stats_moment_mask.f90: stdlib_stats_moment_mask.fypp -stdlib_stats_moment_scalar.f90: stdlib_stats_moment_scalar.fypp -stdlib_stats_var.f90: stdlib_stats_var.fypp -stdlib_stats_distribution_PRNG.f90: stdlib_stats_distribution_PRNG.fypp -stdlib_stats_distribution_uniform.f90: stdlib_stats_distribution_uniform.fypp -stdlib_stats_distribution_exponential.f90: stdlib_stats_distribution_exponential.fypp From 42988073b1becfffa45939303956b7bd953f0846 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 21 Jan 2021 20:20:09 -0500 Subject: [PATCH 40/55] Update Makefile.manual --- src/Makefile.manual | 121 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 121 insertions(+) diff --git a/src/Makefile.manual b/src/Makefile.manual index 9351a374a..f14d02955 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -1,3 +1,112 @@ +SRCFYPP =\ + stdlib_bitsets_64.fypp \ + stdlib_bitsets_large.fypp \ + stdlib_bitsets.fypp \ + stdlib_io.fypp \ + stdlib_linalg.fypp \ + stdlib_linalg_diag.fypp \ + stdlib_optval.fypp \ + stdlib_quadrature.fypp \ + stdlib_quadrature_trapz.fypp \ + stdlib_quadrature_simps.fypp \ + stdlib_stats.fypp \ + stdlib_stats_corr.fypp \ + stdlib_stats_cov.fypp \ + stdlib_stats_mean.fypp \ + stdlib_stats_moment.fypp \ + stdlib_stats_moment_all.fypp \ + stdlib_stats_moment_mask.fypp \ + stdlib_stats_moment_scalar.fypp \ + stdlib_stats_var.fypp \ + stdlib_stats_distribution_PRNG.fypp \ + stdlib_stats_distribution_uniform.fypp \ + stdlib_stats_distribution_exponential.fypp + +SRC = f18estop.f90 \ + stdlib_ascii.f90 \ + stdlib_error.f90 \ + stdlib_kinds.f90 \ + stdlib_logger.f90 \ + $(SRCGEN) + +LIB = libstdlib.a + + +SRCGEN = $(SRCFYPP:.fypp=.f90) +OBJS = $(SRC:.f90=.o) +MODS = $(OBJS:.o=.mod) +SMODS = $(OBJS:.o=*.smod) + +.PHONY: all clean + +all: $(LIB) + +$(LIB): $(OBJS) + ar rcs $@ $(OBJS) + +clean: + $(RM) $(LIB) $(OBJS) $(MODS) $(SMODS) $(SRCGEN) + +%.o: %.f90 + $(FC) $(FFLAGS) -c $< + +$(SRCGEN): %.f90: %.fypp common.fypp + fypp $(FYPPFLAGS) $< $@ + +# Fortran module dependencies +f18estop.o: stdlib_error.o +stdlib_bitsets.o: stdlib_kinds.o +stdlib_bitsets_64.o: stdlib_bitsets.o +stdlib_bitsets_large.o: stdlib_bitsets.o +stdlib_error.o: stdlib_optval.o +stdlib_io.o: \ + stdlib_error.o \ + stdlib_optval.o \ + stdlib_kinds.o +stdlib_linalg.o: \ + stdlib_kinds.o +stdlib_linalg_diag.o: \ + stdlib_linalg.o \ + stdlib_kinds.o +stdlib_logger.o: stdlib_ascii.o stdlib_optval.o +stdlib_optval.o: stdlib_kinds.o +stdlib_quadrature.o: stdlib_kinds.o +stdlib_quadrature_simps.o: \ + stdlib_quadrature.o \ + stdlib_error.o \ + stdlib_kinds.o +stdlib_quadrature_trapz.o: \ + stdlib_quadrature.o \ + stdlib_error.o \ + stdlib_kinds.o +stdlib_stats.o: \ + stdlib_kinds.o +stdlib_stats_corr.o: \ + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o +stdlib_stats_cov.o: \ + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o +stdlib_stats_mean.o: \ + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o +stdlib_stats_moment.o: \ + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o +stdlib_stats_moment_all.o: \ + stdlib_stats_moment.o +stdlib_stats_moment_mask.o: \ + stdlib_stats_moment.o +stdlib_stats_moment_scalar.o: \ + stdlib_stats_moment.o +stdlib_stats_var.o: \ + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o SRCFYPP =\ stdlib_bitsets_64.fypp \ stdlib_bitsets_large.fypp \ @@ -104,3 +213,15 @@ stdlib_stats_var.o: \ stdlib_optval.o \ stdlib_kinds.o \ stdlib_stats.o +stdlib_stats_distribution_PRNG.o: \ + stdlib_kinds.o \ + stdlib_error.o +stdlib_stats_distribution_uniform.o: \ + stdlib_kinds.o \ + stdlib_error.o \ + stdlib_stats_distribution_PRNG.o +stdlib_stats_distribution_exponential.o: \ + stdlib_kinds.o \ + stdlib_error.o \ + stdlib_stats_distribution_PRNG.o \ + stdlib_stats_distribution_uniform.o From 1f40ba2563c0104a929dcad5161447ef5d0149c6 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 21 Jan 2021 20:30:44 -0500 Subject: [PATCH 41/55] Add files via upload --- src/tests/stats/test_distribution_exponential.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/stats/test_distribution_exponential.f90 b/src/tests/stats/test_distribution_exponential.f90 index e7aa9cd34..0318a32bc 100644 --- a/src/tests/stats/test_distribution_exponential.f90 +++ b/src/tests/stats/test_distribution_exponential.f90 @@ -2,7 +2,7 @@ program test_distribution_expon use stdlib_kinds use stdlib_error, only : check use stdlib_stats_distribution_PRNG, only : random_seed - use stdlib_stats_distribution_expon, only : & + use stdlib_stats_distribution_exponential, only : & expon_rvs => exponential_distribution_rvs, & expon_pdf => exponential_distribution_pdf, & expon_cdf => exponential_distribution_cdf From 82109a14bf909f8c0011512a166027a46c4bb309 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Thu, 21 Jan 2021 22:49:57 -0500 Subject: [PATCH 42/55] Update Makefile.manual --- src/Makefile.manual | 106 -------------------------------------------- 1 file changed, 106 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index f14d02955..64acae3cb 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -32,112 +32,6 @@ SRC = f18estop.f90 \ LIB = libstdlib.a -SRCGEN = $(SRCFYPP:.fypp=.f90) -OBJS = $(SRC:.f90=.o) -MODS = $(OBJS:.o=.mod) -SMODS = $(OBJS:.o=*.smod) - -.PHONY: all clean - -all: $(LIB) - -$(LIB): $(OBJS) - ar rcs $@ $(OBJS) - -clean: - $(RM) $(LIB) $(OBJS) $(MODS) $(SMODS) $(SRCGEN) - -%.o: %.f90 - $(FC) $(FFLAGS) -c $< - -$(SRCGEN): %.f90: %.fypp common.fypp - fypp $(FYPPFLAGS) $< $@ - -# Fortran module dependencies -f18estop.o: stdlib_error.o -stdlib_bitsets.o: stdlib_kinds.o -stdlib_bitsets_64.o: stdlib_bitsets.o -stdlib_bitsets_large.o: stdlib_bitsets.o -stdlib_error.o: stdlib_optval.o -stdlib_io.o: \ - stdlib_error.o \ - stdlib_optval.o \ - stdlib_kinds.o -stdlib_linalg.o: \ - stdlib_kinds.o -stdlib_linalg_diag.o: \ - stdlib_linalg.o \ - stdlib_kinds.o -stdlib_logger.o: stdlib_ascii.o stdlib_optval.o -stdlib_optval.o: stdlib_kinds.o -stdlib_quadrature.o: stdlib_kinds.o -stdlib_quadrature_simps.o: \ - stdlib_quadrature.o \ - stdlib_error.o \ - stdlib_kinds.o -stdlib_quadrature_trapz.o: \ - stdlib_quadrature.o \ - stdlib_error.o \ - stdlib_kinds.o -stdlib_stats.o: \ - stdlib_kinds.o -stdlib_stats_corr.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o -stdlib_stats_cov.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o -stdlib_stats_mean.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o -stdlib_stats_moment.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o -stdlib_stats_moment_all.o: \ - stdlib_stats_moment.o -stdlib_stats_moment_mask.o: \ - stdlib_stats_moment.o -stdlib_stats_moment_scalar.o: \ - stdlib_stats_moment.o -stdlib_stats_var.o: \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o -SRCFYPP =\ - stdlib_bitsets_64.fypp \ - stdlib_bitsets_large.fypp \ - stdlib_bitsets.fypp \ - stdlib_io.fypp \ - stdlib_linalg.fypp \ - stdlib_linalg_diag.fypp \ - stdlib_optval.fypp \ - stdlib_quadrature.fypp \ - stdlib_quadrature_trapz.fypp \ - stdlib_quadrature_simps.fypp \ - stdlib_stats.fypp \ - stdlib_stats_corr.fypp \ - stdlib_stats_cov.fypp \ - stdlib_stats_mean.fypp \ - stdlib_stats_moment.fypp \ - stdlib_stats_moment_all.fypp \ - stdlib_stats_moment_mask.fypp \ - stdlib_stats_moment_scalar.fypp \ - stdlib_stats_var.fypp - -SRC = f18estop.f90 \ - stdlib_ascii.f90 \ - stdlib_error.f90 \ - stdlib_kinds.f90 \ - stdlib_logger.f90 \ - $(SRCGEN) - -LIB = libstdlib.a - - SRCGEN = $(SRCFYPP:.fypp=.f90) OBJS = $(SRC:.f90=.o) MODS = $(OBJS:.o=.mod) From 4b96a77383c27802bf7e7266cc39d86af1b32751 Mon Sep 17 00:00:00 2001 From: jim-215-fisher Date: Sun, 12 Dec 2021 16:53:15 -0500 Subject: [PATCH 43/55] update the exponential distribution --- doc/specs/index.md | 1 + .../stdlib_stats_distribution_exponential.md | 115 ++-- src/CMakeLists.txt | 1 + src/Makefile.manual | 6 + ...stdlib_stats_distribution_exponential.fypp | 305 +++++----- src/tests/stats/CMakeLists.txt | 2 + src/tests/stats/Makefile.manual | 3 +- .../stats/test_distribution_exponential.f90 | 540 ------------------ .../stats/test_distribution_exponential.fypp | 276 +++++++++ 9 files changed, 494 insertions(+), 755 deletions(-) delete mode 100644 src/tests/stats/test_distribution_exponential.f90 create mode 100644 src/tests/stats/test_distribution_exponential.fypp diff --git a/doc/specs/index.md b/doc/specs/index.md index 7a7a6f143..77a8cef8d 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -26,6 +26,7 @@ This is and index/directory of the specifications (specs) for each new module/fe - [stats](./stdlib_stats.html) - Descriptive Statistics - [stats_distributions_uniform](./stdlib_stats_distribution_uniform.html) - Uniform Probability Distribution - [stats_distributions_normal](./stdlib_stats_distribution_normal.html) - Normal Probability Distribution + - [stats_distributions_exponential](./stdlib_stats_distribution_exponential.html) - Exponential Probability Distribution - [string\_type](./stdlib_string_type.html) - Basic string support - [strings](./stdlib_strings.html) - String handling and manipulation routines - [stringlist_type](./stdlib_stringlist_type.html) - 1-Dimensional list of strings diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md index d9e3d4f5e..72e6ffe9c 100644 --- a/doc/specs/stdlib_stats_distribution_exponential.md +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -1,12 +1,12 @@ --- -title: stats_distribution +title: stats_distribution_exponential --- -# Statistical Distributions -- Exponential Module +# Statistical Distributions -- Exponential Distribution Module [TOC] -## `exponential_distribution_rvs` - exponential distribution random variates +## `rvs_expon` - exponential distribution random variates ### Status @@ -14,35 +14,40 @@ Experimental ### Description -An exponentially distributed random variate distribution is the distribution of time between events in a Poisson point process. The inverse scale parameter `lamda` specifies the rate of change. +An exponentially distributed random variate distribution is the distribution of time between events in a Poisson point process. The inverse scale parameter `lambda` specifies the rate of change. -Without augument the function returns a standard exponential distributed random variate with `lamda = 1.0`. The function is elemental. +Without argument the function returns a standard exponential distributed random variate E(1) with `lambda = 1`. -With single argument, the function returns an exponential distributed random variate E(lamda). The function is elemental. For complex auguments, the real and imaginary parts are independent of each other. +With single argument, the function returns an exponential distributed random variate E(lambda). For complex arguments, the real and imaginary parts are independent of each other. -With two auguments the function returns a rank one array of random variates. +With two arguments the function returns a rank one array of exponential distributed random variates. + +Note: the algorithm used for generating normal random variates is fundamentally limited to double precision. ### Syntax -`result = [[stdlib_stats_distribution_exponential(module):exponential_distribution_rvs(interface)]]([lamda] [[, array_size]])` +`result = [[stdlib_stats_distribution_exponential(module):rvs_expon(interface)]]([lambda] [[, array_size]])` + +### Class + +Function ### Arguments -`lamda`: optional argument has `intent(in)` and is a scalar of type `real` or `complex`. +`lambda`: optional argument has `intent(in)` and is a scalar of type `real` or `complex`. -`array_size`: optional argument has `intent(in)` and is a scalar of type `integer`. +`array_size`: optional argument has `intent(in)` and is a scalar of type `integer` with default kind. ### Return value -The result is a scalar or rank one array, with a size of `array_size`, of type `real` or `complex`. +The result is a scalar or rank one array with a size of `array_size`, and as the same type of `lambda`. ### Example ```fortran program demo_exponential_rvs - use stdlib_stats_distribution_PRNG, only : random_seed - use stdlib_stats_distribution_exponential, only: & - rexp => exponential_distribution_rvs + use stdlib_random, only : random_seed + use stdlib_stats_distribution_exponential, only: rexp => rvs_expon implicit none real :: a(2,3,4) @@ -56,35 +61,26 @@ program demo_exponential_rvs ! 0.358690143 - print *, rexp(2.0) !exponential random variate with lamda=2.0 + print *, rexp(2.0) !exponential random variate with lambda=2.0 ! 0.816459715 - print *, rexp(0.3, 10) !an array of 10 variates with lamda=0.3 + print *, rexp(0.3, 10) !an array of 10 variates with lambda=0.3 ! 1.84008647E-02 3.59742008E-02 0.136567295 0.262772143 3.62352766E-02 ! 0.547133625 0.213591918 4.10784185E-02 0.583882213 0.671128035 - a(:,:,:) = 0.5 - print *, rexp(a) !a rank 3 array of 24 exponential random variates - -! 0.219550118 0.318272740 0.426896989 0.803026378 0.395067871 -! 5.93891777E-02 0.809226036 1.27890170 1.38805652 0.179149821 -! 1.75288841E-02 7.23171830E-02 0.157068044 0.153069839 0.421180248 -! 0.517792642 2.09411430 0.785641313 0.116311245 0.295113146 -! 0.824005902 0.123385273 5.50238751E-02 3.52851897E-02 - scale = (2.0, 0.7) print *, rexp(scale) - !single complex exponential random variate with real part of lamda=2.0; - !imagainary part of lamda=0.7 + !single complex exponential random variate with real part of lambda=2.0; + !imagainary part of lambda=0.7 ! (1.41435969,4.081114382E-02) end program demo_exponential_rvs ``` -## `exponential_distribution_pdf` - exponential probability density function +## `pdf_expon` - exponential distribution probability density function ### Status @@ -92,34 +88,41 @@ Experimental ### Description -The probability density function of the continuous exponential distribution. +The probability density function (pdf) of the single real variable exponential distribution: + +$$f(x)=\begin{cases} \lambda e^{-\lambda x} &x\geqslant 0 \\\\ 0 &x< 0\end{}$$ -$$ f(x)=\begin{cases}lamda \times e^{-lamda \times x} &x\geqslant 0 \\\\ 0 &x< 0\end{} $$ +For complex varible (x + y i) with independent real x and imaginary y parts, the joint probability density function is the product of corresponding marginal pdf of real and imaginary pdf (ref. "Probability and Random Processes with Applications to Signal Processing and Communications", 2nd ed., Scott L. Miller and Donald Childers, 2012, p.197): + +$$f(x+\mathit{i}y)=f(x)f(y)=\begin{cases} \lambda_{x} \lambda_{y} e^{-(\lambda_{x} x + \lambda_{y} y)} &x\geqslant 0, y\geqslant 0 \\\\ 0 &otherwise\end{}$$ ### Syntax -`result = [[stdlib_stats_distribution_exponential(module):exponential_distribution_pdf(interface)]](x, lamda)` +`result = [[stdlib_stats_distribution_exponential(module):pdf_expon(interface)]](x, lambda)` + +### Class + +Elemental function ### Arguments `x`: has `intent(in)` and is a scalar of type `real` or `complex`. -`lamda`: has `intent(in)` and is a scalar of type `real` or `complex`. +`lambda`: has `intent(in)` and is a scalar of type `real` or `complex`. -The function is elemental, i.e., all auguments could be arrays conformable to each other. All arguments must have the same type. +All arguments must have the same type. ### Return value -The result is a scalar or an array, with a shape conformable to auguments, of type `real`. +The result is a scalar or an array, with a shape conformable to arguments, and as the same type of input arguments. ### Example ```fortran program demo_exponential_pdf - use stdlib_stats_distribution_PRNG, only : random_seed - use stdlib_stats_distribution_exponential, only: & - exp_pdf => exponential_distribution_pdf, & - rexp => exponential_distribution_rvs + use stdlib_random, only : random_seed + use stdlib_stats_distribution_exponential, only: exp_pdf => pdf_expon, & + rexp => rvs_expon implicit none real :: x(2,3,4),a(2,3,4) @@ -133,7 +136,7 @@ program demo_exponential_pdf ! 0.367879450 - print *, exp_pdf(2.0,2.0) !a probability density at 2.0 with lamda=2.0 + print *, exp_pdf(2.0,2.0) !a probability density at 2.0 with lambda=2.0 ! 3.66312787E-02 @@ -150,14 +153,14 @@ program demo_exponential_pdf scale = (1.0, 2.) print *, exp_pdf((1.5,1.0), scale) ! a complex expon probability density function at (1.5,1.0) with real part - !of lamda=1.0 and imaginary part of lamda=2.0 + !of lambda=1.0 and imaginary part of lambda=2.0 ! 6.03947677E-02 end program demo_exponential_pdf ``` -## `exponential_distribution_cdf` - exponential cumulative distribution function +## `cdf_expon` - exponential distribution cumulative distribution function ### Status @@ -165,35 +168,41 @@ Experimental ### Description -Cumulative distribution function of the exponential continuous distribution +Cumulative distribution function (cdf) of the single real variable exponential distribution: -$$ F(x)=\begin{cases}1 - e^{-lamda \times x} &x\geqslant 0 \\\\ 0 &x< 0\end{} $$ +$$F(x)=\begin{cases}1 - e^{-\lambda x} &x\geqslant 0 \\\\ 0 &x< 0\end{}$$ +For the complex variable (x + y i) with independent real x and imaginary y parts, the joint cumulative distribution function is the product of corresponding marginal cdf of real and imaginary cdf (ref. "Probability and Random Processes with Applications to Signal Processing and Communications", 2nd ed., Scott L. Miller and Donald Childers, 2012, p.197): + +$$F(x+\mathit{i}y)=F(x)F(y)=\begin{cases} (1 - e^{-\lambda_{x} x})(1 - e^{-\lambda_{y} y}) &x\geqslant 0, \;\; y\geqslant 0 \\\\ 0 &otherwise \end{}$$ ### Syntax -`result = [[stdlib_stats_distribution_exponential(module):exponential_distribution_cdf(interface)]](x, lamda)` +`result = [[stdlib_stats_distribution_exponential(module):cdf_expon(interface)]](x, lambda)` + +### Class + +Elemental function ### Arguments `x`: has `intent(in)` and is a scalar of type `real` or `complex`. -`lamda`: has `intent(in)` and is a scalar of type `real` or `complex`. +`lambda`: has `intent(in)` and is a scalar of type `real` or `complex`. -The function is elemental, i.e., all auguments could be arrays conformable to each other. All arguments must have the same type. +All arguments must have the same type. ### Return value -The result is a scalar or an array, with a shape conformable to auguments, of type `real`. +The result is a scalar or an array, with a shape conformable to arguments, and as the same type of input arguments. ### Example ```fortran program demo_exponential_cdf - use stdlib_stats_distribution_PRNG, only : random_seed - use stdlib_stats_distribution_exponential, only : & - exp_cdf => exponential_distribution_cdf, & - rexp => exponential_distribution_rvs + use stdlib_random, only : random_seed + use stdlib_stats_distribution_exponential, only : exp_cdf => cdf_expon, & + rexp => rvs_expon implicit none real :: x(2,3,4),a(2,3,4) @@ -207,7 +216,7 @@ program demo_exponential_cdf ! 0.632120550 - print *, exp_cdf(2.0, 2.0) ! a cumulative at 2.0 with lamda=2 + print *, exp_cdf(2.0, 2.0) ! a cumulative at 2.0 with lambda=2 ! 0.981684387 @@ -225,7 +234,7 @@ program demo_exponential_cdf scale = (0.5,1.0) print *, exp_cdf((0.5,0.5),scale) !complex exponential cumulative distribution at (0.5,0.5) with real part of - !lamda=0.5 and imaginary part of lamda=1.0 + !lambda=0.5 and imaginary part of lambda=1.0 ! 8.70351046E-02 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3e8ff4568..5a1d6b826 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -31,6 +31,7 @@ set(fppFiles stdlib_stats_moment_scalar.fypp stdlib_stats_distribution_uniform.fypp stdlib_stats_distribution_normal.fypp + stdlib_stats_distribution_exponential.fypp stdlib_stats_var.fypp stdlib_quadrature.fypp stdlib_quadrature_trapz.fypp diff --git a/src/Makefile.manual b/src/Makefile.manual index 57c681fd7..b8ab36f52 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -33,6 +33,7 @@ SRCFYPP = \ stdlib_stats_moment_scalar.fypp \ stdlib_stats_distribution_uniform.fypp \ stdlib_stats_distribution_normal.fypp \ + stdlib_stats_distribution_exponential.fypp \ stdlib_stats_var.fypp \ stdlib_math.fypp \ stdlib_math_linspace.fypp \ @@ -173,6 +174,11 @@ stdlib_stats_distribution_normal.o: \ stdlib_error.o \ stdlib_random.o \ stdlib_stats_distribution_uniform.o +stdlib_stats_distribution_exponential.o: \ + stdlib_kinds.o \ + stdlib_error.o \ + stdlib_random.o \ + stdlib_stats_distribution_uniform.o stdlib_random.o: \ stdlib_kinds.o \ stdlib_error.o diff --git a/src/stdlib_stats_distribution_exponential.fypp b/src/stdlib_stats_distribution_exponential.fypp index 750170939..56b877bdf 100644 --- a/src/stdlib_stats_distribution_exponential.fypp +++ b/src/stdlib_stats_distribution_exponential.fypp @@ -1,66 +1,76 @@ #:include "common.fypp" #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES -Module stdlib_stats_distribution_exponential - use stdlib_kinds +module stdlib_stats_distribution_exponential + use stdlib_kinds, only : sp, dp, xdp, qp, int32 use stdlib_error, only : error_stop - use stdlib_stats_distribution_PRNG, only : dist_rand - use stdlib_stats_distribution_uniform, only : uni=>uniform_distribution_rvs + use stdlib_random, only : dist_rand + use stdlib_stats_distribution_uniform, only : uni=>rvs_uniform implicit none private - real(dp), parameter :: HALF = 0.5_dp, ONE = 1.0_dp, TWO = 2.0_dp - integer, save :: ke(0:255) - real(dp), save :: we(0:255), fe(0:255) - logical, save :: zig_exp_initialized = .false. - public :: exponential_distribution_rvs - public :: exponential_distribution_pdf - public :: exponential_distribution_cdf + real(dp), parameter :: ONE = 1.0_dp + integer :: ke(0:255) + real(dp) :: we(0:255), fe(0:255) + logical :: zig_exp_initialized = .false. - interface exponential_distribution_rvs + public :: rvs_expon + public :: pdf_expon + public :: cdf_expon + + + + interface rvs_expon !! Version experimental !! !! Exponential Distribution Random Variates - !!([Specification](../page/specs/stdlib_stats_distribution_exponential.html# - !! description)) + !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# + !! rvs_expon-exponential-distribution-random-variates)) !! - module procedure exp_dist_rvs_0_rsp !0 dummy variable + module procedure rvs_expon_0_rsp !0 dummy variable #:for k1, t1 in RC_KINDS_TYPES - module procedure exp_dist_rvs_${t1[0]}$${k1}$ !1 dummy variable + module procedure rvs_expon_${t1[0]}$${k1}$ !1 dummy variable #:endfor #:for k1, t1 in RC_KINDS_TYPES - module procedure exp_dist_rvs_array_${t1[0]}$${k1}$ !2 dummy variables + module procedure rvs_expon_array_${t1[0]}$${k1}$ !2 dummy variables #:endfor - end interface exponential_distribution_rvs + end interface rvs_expon + - interface exponential_distribution_pdf + + interface pdf_expon !! Version experimental !! !! Exponential Distribution Probability Density Function - !!([Specification](../page/specs/stdlib_stats_distribution_exponential.html# - !! description)) + !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# + !! pdf_expon-exponential-distribution-probability-density-function)) !! #:for k1, t1 in RC_KINDS_TYPES - module procedure exp_dist_pdf_${t1[0]}$${k1}$ + module procedure pdf_expon_${t1[0]}$${k1}$ #:endfor - end interface exponential_distribution_pdf + end interface pdf_expon + - interface exponential_distribution_cdf + + interface cdf_expon !! Version experimental !! !! Exponential Distribution Cumulative Distribution Function !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# - !! description)) + !! cdf_expon-exponential-distribution-cumulative-distribution-function)) !! #:for k1, t1 in RC_KINDS_TYPES - module procedure exp_dist_cdf_${t1[0]}$${k1}$ + module procedure cdf_expon_${t1[0]}$${k1}$ #:endfor - end interface exponential_distribution_cdf + end interface cdf_expon + - contains + + +contains subroutine zigset ! Marsaglia & Tsang generator for random normals & random exponentials. @@ -72,54 +82,48 @@ Module stdlib_stats_distribution_exponential ! This is an electronic journal which can be downloaded from: ! http://www.jstatsoft.org/v05/i08 ! - ! N.B. It is assumed that all integers are 32-bit. - ! N.B. The value of M2 has been halved to compensate for the lack of - ! unsigned integers in Fortran. - ! ! Latest version - 1 January 2001 ! - ! Fotran 90 program translated from C by Jim-215-Fisher - ! - real(dp), parameter :: M2 = 2147483648.0_dp - real(dp) :: de = 7.697117470131487_dp, te, & - ve = 0.003949659822581572_dp, q + real(dp), parameter :: M2 = 2147483648.0_dp, ve = 0.003949659822581572_dp + real(dp) :: de, te, q integer :: i + de = 7.697117470131487_dp te = de - ! tables for random exponetials - q = ve * exp( de ) + !tables for random exponetials + q = ve * exp(de) ke(0) = int((de / q) * M2, kind = int32) ke(1) = 0 we(0) = q / M2 we(255) = de / M2 fe(0) = ONE - fe(255) = exp( -de ) + fe(255) = exp(- de) do i = 254, 1, -1 - de = -log( ve / de + exp( -de ) ) + de = -log(ve / de + exp(- de)) ke(i+1) = int(M2 * (de / te), kind = int32) te = de - fe(i) = exp( -de ) + fe(i) = exp(- de) we(i) = de / M2 end do zig_exp_initialized = .true. - return end subroutine zigset + + + #:for k1, t1 in REAL_KINDS_TYPES - impure elemental function exp_dist_rvs_0_${t1[0]}$${k1}$( ) result(res) - ! Exponential distributed random variate with lamda = 1 + function rvs_expon_0_${t1[0]}$${k1}$( ) result(res) + ! + ! Standard exponential random variate (lambda=1) ! ${t1}$ :: res, x - ${t1}$ :: r = 7.69711747013104972_${k1}$ + ${t1}$, parameter :: r = 7.69711747013104972_${k1}$ integer :: jz, iz - if( .not. zig_exp_initialized ) call zigset - - ! Original algorithm use 32bit + if(.not. zig_exp_initialized ) call zigset iz = 0 - jz = dist_rand(1_int32) - - iz = iand( jz, 255 ) + jz = dist_rand(1_int32) !32bit random integer + iz = iand( jz, 255 ) !random integer in [0, 255] if( abs( jz ) < ke(iz) ) then res = abs(jz) * we(iz) else @@ -133,8 +137,6 @@ Module stdlib_stats_distribution_exponential res = x exit L1 end if - - !original algorithm use 32bit jz = dist_rand(1_int32) iz = iand( jz, 255 ) if( abs( jz ) < ke(iz) ) then @@ -143,92 +145,64 @@ Module stdlib_stats_distribution_exponential end if end do L1 endif - return - end function exp_dist_rvs_0_${t1[0]}$${k1}$ + end function rvs_expon_0_${t1[0]}$${k1}$ #:endfor + + + #:for k1, t1 in REAL_KINDS_TYPES - impure elemental function exp_dist_rvs_${t1[0]}$${k1}$(lamda) result(res) + function rvs_expon_${t1[0]}$${k1}$(lambda) result(res) + ! ! Exponential distributed random variate ! - ${t1}$, intent(in) :: lamda - ${t1}$ :: res, x - ${t1}$ :: r = 7.69711747013104972_${k1}$ - integer(int32) :: jz, iz + ${t1}$, intent(in) :: lambda + ${t1}$ :: res - if(lamda <= 0.0_${k1}$) call error_stop("Error(exp_dist_rvs):" & - //" Exponential distribution lamda parameter must be greater than zero") - if( .not. zig_exp_initialized ) call zigset + if(lambda <= 0.0_${k1}$) call error_stop("Error(rvs_expon): Exponen" & + //"tial distribution lambda parameter must be greater than zero") + res = rvs_expon_0_${t1[0]}$${k1}$( ) + res = res / lambda + end function rvs_expon_${t1[0]}$${k1}$ - ! Original algorithm use 32bit - iz = 0 - jz = dist_rand(1_int32) + #:endfor - iz = iand( jz, 255 ) - if( abs( jz ) < ke(iz) ) then - res = abs(jz) * we(iz) - else - L1: do - if( iz == 0 ) then - res = r - log( uni(1.0_${k1}$) ) - exit L1 - end if - x = abs( jz ) * we(iz) - if(fe(iz) + uni(1.0_${k1}$) * (fe(iz-1) - fe(iz)) < exp(-x)) then - res = x - exit L1 - end if - !original algorithm use 32bit - jz = dist_rand(1_int32) - iz = iand( jz, 255 ) - if( abs( jz ) < ke(iz) ) then - res = abs( jz ) * we(iz) - exit L1 - end if - end do L1 - endif - res = res * lamda - return - end function exp_dist_rvs_${t1[0]}$${k1}$ - #:endfor #:for k1, t1 in CMPLX_KINDS_TYPES - impure elemental function exp_dist_rvs_${t1[0]}$${k1}$(lamda) result(res) - ${t1}$, intent(in) :: lamda + function rvs_expon_${t1[0]}$${k1}$(lambda) result(res) + ${t1}$, intent(in) :: lambda ${t1}$ :: res real(${k1}$) :: tr, ti - tr = exp_dist_rvs_r${k1}$(real(lamda)) - ti = exp_dist_rvs_r${k1}$(aimag(lamda)) + tr = rvs_expon_r${k1}$(lambda % re) + ti = rvs_expon_r${k1}$(lambda % im) res = cmplx(tr, ti, kind=${k1}$) - return - end function exp_dist_rvs_${t1[0]}$${k1}$ + end function rvs_expon_${t1[0]}$${k1}$ #:endfor + + + #:for k1, t1 in REAL_KINDS_TYPES - function exp_dist_rvs_array_${t1[0]}$${k1}$(lamda, array_size) result(res) - ${t1}$, intent(in) :: lamda - ${t1}$, allocatable :: res(:) + function rvs_expon_array_${t1[0]}$${k1}$(lambda, array_size) result(res) + ${t1}$, intent(in) :: lambda integer, intent(in) :: array_size - ${t1}$ :: x, re - ${t1}$ :: r = 7.69711747013104972_${k1}$ + ${t1}$ :: res(array_size), x, re + ${t1}$, parameter :: r = 7.69711747013104972_${k1}$ integer :: jz, iz, i - if(lamda <= 0.0_${k1}$) call error_stop("Error(exp_dist_rvs_array):" & - //" Exponential distribution lamda parameter must be greater than zero") + if(lambda <= 0.0_${k1}$) call error_stop("Error(rvs_expon_array): Exp" & + //"oonential distribution lambda parameter must be greater than zero") - if( .not. zig_exp_initialized ) call zigset - allocate(res(array_size)) - do i =1, array_size - ! Original algorithm use 32bit + if(.not. zig_exp_initialized) call zigset + do i = 1, array_size iz = 0 jz = dist_rand(1_int32) - iz = iand( jz, 255 ) if( abs( jz ) < ke(iz) ) then re = abs(jz) * we(iz) @@ -243,8 +217,6 @@ Module stdlib_stats_distribution_exponential re = x exit L1 end if - - !original algorithm use 32bit jz = dist_rand(1_int32) iz = iand( jz, 255 ) if( abs( jz ) < ke(iz) ) then @@ -253,87 +225,98 @@ Module stdlib_stats_distribution_exponential end if end do L1 endif - res(i) = re * lamda + res(i) = re / lambda end do - return - end function exp_dist_rvs_array_${t1[0]}$${k1}$ + end function rvs_expon_array_${t1[0]}$${k1}$ #:endfor + + + #:for k1, t1 in CMPLX_KINDS_TYPES - function exp_dist_rvs_array_${t1[0]}$${k1}$(lamda, array_size) result(res) - ${t1}$, intent(in) :: lamda + function rvs_expon_array_${t1[0]}$${k1}$(lambda, array_size) result(res) + ${t1}$, intent(in) :: lambda integer, intent(in) :: array_size - ${t1}$, allocatable :: res(:) + ${t1}$ :: res(array_size) integer :: i real(${k1}$) :: tr, ti - allocate(res(array_size)) do i = 1, array_size - tr = exp_dist_rvs_r${k1}$(real(lamda)) - ti = exp_dist_rvs_r${k1}$(aimag(lamda)) + tr = rvs_expon_r${k1}$(lambda % re) + ti = rvs_expon_r${k1}$(lambda % im) res(i) = cmplx(tr, ti, kind=${k1}$) end do - return - end function exp_dist_rvs_array_${t1[0]}$${k1}$ + end function rvs_expon_array_${t1[0]}$${k1}$ #:endfor + + + #:for k1, t1 in REAL_KINDS_TYPES - impure elemental function exp_dist_pdf_${t1[0]}$${k1}$(x, lamda) result(res) + impure elemental function pdf_expon_${t1[0]}$${k1}$(x, lambda) result(res) + ! ! Exponential Distribution Probability Density Function ! - ${t1}$, intent(in) :: x, lamda - real :: res + ${t1}$, intent(in) :: x, lambda + real(${k1}$) :: res - if(lamda <= 0.0_${k1}$) call error_stop("Error(exp_dist_pdf):" & - //" Exponential distribution lamda parameter must be greater than zero") - if(x < 0.0_${k1}$) call error_stop("Error(exp_dist_pdf): Exponential" & - //" distribution variate x must be non-negative") - res = exp(- x * lamda) * lamda - return - end function exp_dist_pdf_${t1[0]}$${k1}$ + if(lambda <= 0.0_${k1}$) call error_stop("Error(pdf_expon): Expon" & + //"ential distribution lambda parameter must be greater than zero") + if(x < 0.0_${k1}$) call error_stop("Error(pdf_expon): Exponential" & + //" distribution variate x must be non-negative") + res = exp(- x * lambda) * lambda + end function pdf_expon_${t1[0]}$${k1}$ #:endfor + + + #:for k1, t1 in CMPLX_KINDS_TYPES - impure elemental function exp_dist_pdf_${t1[0]}$${k1}$(x, lamda) result(res) - ${t1}$, intent(in) :: x, lamda - real :: res + impure elemental function pdf_expon_${t1[0]}$${k1}$(x, lambda) result(res) + ${t1}$, intent(in) :: x, lambda + real(${k1}$) :: res - res = exp_dist_pdf_r${k1}$(real(x), real(lamda)) - res = res * exp_dist_pdf_r${k1}$(aimag(x), aimag(lamda)) - return - end function exp_dist_pdf_${t1[0]}$${k1}$ + res = pdf_expon_r${k1}$(x % re, lambda % re) + res = res * pdf_expon_r${k1}$(x % im, lambda % im) + end function pdf_expon_${t1[0]}$${k1}$ #:endfor + + + #:for k1, t1 in REAL_KINDS_TYPES - impure elemental function exp_dist_cdf_${t1[0]}$${k1}$(x, lamda) result(res) - ! Exponential Cumulative Distribution Function + impure elemental function cdf_expon_${t1[0]}$${k1}$(x, lambda) result(res) + ! + ! Exponential Distribution Cumulative Distribution Function ! - ${t1}$, intent(in) :: x, lamda - real :: res + ${t1}$, intent(in) :: x, lambda + real(${k1}$) :: res - if(lamda <= 0.0_${k1}$) call error_stop("Error(exp_dist_cdf):" & - //" Exponential distribution lamda parameter must be greater than zero") - if(x < 0.0_${k1}$) call error_stop("Error(exp_dist_cdf): Exponential" & - //" distribution variate x must be non-negative") - res = (1.0 - exp(- x * lamda)) - return - end function exp_dist_cdf_${t1[0]}$${k1}$ + if(lambda <= 0.0_${k1}$) call error_stop("Error(cdf_expon): Expon" & + //"ential distribution lambda parameter must be greater than zero") + if(x < 0.0_${k1}$) call error_stop("Error(cdf_expon): Exponential" & + //" distribution variate x must be non-negative") + res = 1.0_${k1}$ - exp(- x * lambda) + end function cdf_expon_${t1[0]}$${k1}$ #:endfor + + + #:for k1, t1 in CMPLX_KINDS_TYPES - impure elemental function exp_dist_cdf_${t1[0]}$${k1}$(x, lamda) result(res) - ${t1}$, intent(in) :: x, lamda - real :: res + impure elemental function cdf_expon_${t1[0]}$${k1}$(x, lambda) result(res) + ${t1}$, intent(in) :: x, lambda + real(${k1}$) :: res - res = exp_dist_cdf_r${k1}$(real(x), real(lamda)) - res = res * exp_dist_cdf_r${k1}$(aimag(x), aimag(lamda)) - return - end function exp_dist_cdf_${t1[0]}$${k1}$ + res = cdf_expon_r${k1}$(x % re, lambda % re) + res = res * cdf_expon_r${k1}$(x % im, lambda % im) + end function cdf_expon_${t1[0]}$${k1}$ #:endfor -end module stdlib_stats_distribution_exponential \ No newline at end of file + +end module stdlib_stats_distribution_exponential diff --git a/src/tests/stats/CMakeLists.txt b/src/tests/stats/CMakeLists.txt index b3b70bd4d..651286708 100644 --- a/src/tests/stats/CMakeLists.txt +++ b/src/tests/stats/CMakeLists.txt @@ -7,6 +7,7 @@ set(fppFiles test_median.fypp test_distribution_uniform.fypp test_distribution_normal.fypp + test_distribution_exponential.fypp ) fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) @@ -22,6 +23,7 @@ ADDTEST(varn) ADDTEST(random) ADDTEST(distribution_uniform) ADDTEST(distribution_normal) +ADDTEST(distribution_exponential) if(DEFINED CMAKE_MAXIMUM_RANK) if(${CMAKE_MAXIMUM_RANK} GREATER 7) diff --git a/src/tests/stats/Makefile.manual b/src/tests/stats/Makefile.manual index 15797d509..5650103ed 100644 --- a/src/tests/stats/Makefile.manual +++ b/src/tests/stats/Makefile.manual @@ -2,7 +2,8 @@ SRCFYPP = \ test_mean.fypp \ test_median.fypp \ test_distribution_uniform.fypp \ - test_distribution_normal.fypp + test_distribution_normal.fypp \ + test_distribution_exponential SRCGEN = $(SRCFYPP:.fypp=.f90) diff --git a/src/tests/stats/test_distribution_exponential.f90 b/src/tests/stats/test_distribution_exponential.f90 deleted file mode 100644 index 0318a32bc..000000000 --- a/src/tests/stats/test_distribution_exponential.f90 +++ /dev/null @@ -1,540 +0,0 @@ -program test_distribution_expon - use stdlib_kinds - use stdlib_error, only : check - use stdlib_stats_distribution_PRNG, only : random_seed - use stdlib_stats_distribution_exponential, only : & - expon_rvs => exponential_distribution_rvs, & - expon_pdf => exponential_distribution_pdf, & - expon_cdf => exponential_distribution_cdf - - implicit none - real(sp), parameter :: sptol = 1000 * epsilon(1.0_sp) - real(dp), parameter :: dptol = 1000 * epsilon(1.0_dp) - real(qp), parameter :: qptol = 1000 * epsilon(1.0_qp) - logical :: warn = .true. - integer :: put, get - - put = 12345678 - call random_seed(put, get) - - call test_exponential_random_generator - - call test_expon_rvs_rsp - call test_expon_rvs_rdp - call test_expon_rvs_rqp - call test_expon_rvs_csp - call test_expon_rvs_cdp - call test_expon_rvs_cqp - - call test_expon_pdf_rsp - call test_expon_pdf_rdp - call test_expon_pdf_rqp - call test_expon_pdf_csp - call test_expon_pdf_cdp - call test_expon_pdf_cqp - - call test_expon_cdf_rsp - call test_expon_cdf_rdp - call test_expon_cdf_rqp - call test_expon_cdf_csp - call test_expon_cdf_cdp - call test_expon_cdf_cqp - - - contains - - subroutine test_exponential_random_generator - integer :: i, j, freq(0:1000), num=10000000 - real(dp) :: chisq, expct - - print *, "" - print *, "Test exponential random generator with chi-squared" - freq = 0 - do i = 1, num - j = 1000 * (1.0 - exp(- expon_rvs(1.0))) - freq(j) = freq(j) + 1 - end do - chisq = 0.0_dp - expct = num / 1000 - do i = 0, 999 - chisq = chisq + (freq(i) - expct) ** 2 / expct - end do - write(*,*) "The critical values for chi-squared with 1000 d. of f. is" & - //" 1143.92" - write(*,*) "Chi-squared for exponential random generator is : ", chisq - call check((chisq < 1143.9), & - msg="exponential randomness failed chi-squared test", warn=warn) - end subroutine test_exponential_random_generator - - subroutine test_expon_rvs_rsp - real(sp) :: res(10), scale - integer :: i, n, k = 5 - integer :: seed, get - real(sp) :: ans(10) = [1.37178108290154243675829093263018876_sp, & - 0.309467303067628429769087006206973456_sp, & - 0.303573393522570872393728791394096334_sp, & - 3.00973636550766943109636031294940040_sp, & - 0.250084097046766984373533659891108982_sp, & - 1.20139122141795795517538181229610927_sp, & - 4.43019214257137261547825346497120336_sp, & - 0.835001950484080046610557701569632627_sp, & - 1.82681711031524329769126779865473509_sp, & - 0.910435173630070204708886194566730410_sp] - - print *, "Test exponential_distribution_rvs_rsp" - seed = 593742186 - call random_seed(seed, get) - scale = 1.5_sp - do i = 1, 5 - res(i) = expon_rvs(scale) - end do - res(6:10) = expon_rvs(scale, k) - call check(all(abs(res - ans) < sptol), & - msg="exponential_distribution_rvs_rsp failed", warn=warn) - end subroutine test_expon_rvs_rsp - - subroutine test_expon_rvs_rdp - real(dp) :: res(10), scale - integer :: i, n, k = 5 - integer :: seed, get - real(dp) :: ans(10) = [1.37178108290154243675829093263018876_dp, & - 0.309467303067628429769087006206973456_dp, & - 0.303573393522570872393728791394096334_dp, & - 3.00973636550766943109636031294940040_dp, & - 0.250084097046766984373533659891108982_dp, & - 1.20139122141795795517538181229610927_dp, & - 4.43019214257137261547825346497120336_dp, & - 0.835001950484080046610557701569632627_dp, & - 1.82681711031524329769126779865473509_dp, & - 0.910435173630070204708886194566730410_dp] - - print *, "Test exponential_distribution_rvs_rdp" - seed = 593742186 - call random_seed(seed, get) - scale = 1.5_dp - do i = 1, 5 - res(i) = expon_rvs(scale) - end do - res(6:10) = expon_rvs(scale, k) - call check(all(abs(res - ans) < dptol), & - msg="exponential_distribution_rvs_rdp failed", warn=warn) - end subroutine test_expon_rvs_rdp - - subroutine test_expon_rvs_rqp - real(qp) :: res(10), scale - integer :: i, n, k = 5 - integer :: seed, get - real(qp) :: ans(10) = [1.37178108290154243675829093263018876_qp, & - 0.309467303067628429769087006206973456_qp, & - 0.303573393522570872393728791394096334_qp, & - 3.00973636550766943109636031294940040_qp, & - 0.250084097046766984373533659891108982_qp, & - 1.20139122141795795517538181229610927_qp, & - 4.43019214257137261547825346497120336_qp, & - 0.835001950484080046610557701569632627_qp, & - 1.82681711031524329769126779865473509_qp, & - 0.910435173630070204708886194566730410_qp] - - print *, "Test exponential_distribution_rvs_rqp" - seed = 593742186 - call random_seed(seed, get) - scale = 1.5_qp - do i = 1, 5 - res(i) = expon_rvs(scale) - end do - res(6:10) = expon_rvs(scale, k) - call check(all(abs(res - ans) < qptol), & - msg="exponential_distribution_rvs_rqp failed", warn=warn) - end subroutine test_expon_rvs_rqp - - subroutine test_expon_rvs_csp - complex(sp) :: res(10), scale - integer :: i, n, k = 5 - integer :: seed, get - complex(sp) :: ans(10) = [(0.640164505354053137153869101894088070_sp, & - 0.268204995991944639133208738712710328_sp), & - (0.141667583643866407117073435983911608_sp, & - 2.60843818343998017361684560455614716_sp), & - (0.116705911955157926040982374615850854_sp, & - 1.04120572522889689448533090398996145_sp), & - (2.06742299986664055388985161698656149_sp, & - 0.723668357086202707062483341360348315_sp), & - (0.852514651480446872255924972705542983_sp, & - 0.789043817146060844081034701957833041_sp), & - (1.09098446025458177821576555288629603_sp, & - 1.48569478096399141264782883808948111_sp), & - (4.29633077423243321391055360436439499_sp, & - 0.338216396454583145825267820328008412_sp), & - (0.340462754402863337910289942556119029_sp, & - 0.172319442815022222381671213042864120_sp), & - (6.932352666201882229746189523211795805E-0002_sp, & - 6.742518436285274002761624956292507704E-0002_sp), & - (1.03231628501970258415809666985296648_sp, & - 0.421413014732743429480166241773986277_sp)] - - print *, "Test exponential_distribution_rvs_csp" - seed = 593742186 - call random_seed(seed, get) - scale = (0.7_sp, 1.3_sp) - do i = 1, 5 - res(i) = expon_rvs(scale) - end do - res(6:10) = expon_rvs(scale, k) - call check(all(abs(res - ans) < sptol), & - msg="exponential_distribution_rvs_csp failed", warn=warn) - end subroutine test_expon_rvs_csp - - subroutine test_expon_rvs_cdp - complex(dp) :: res(10), scale - integer :: i, n, k = 5 - integer :: seed, get - complex(dp) :: ans(10) = [(0.640164505354053137153869101894088070_dp, & - 0.268204995991944639133208738712710328_dp), & - (0.141667583643866407117073435983911608_dp, & - 2.60843818343998017361684560455614716_dp), & - (0.116705911955157926040982374615850854_dp, & - 1.04120572522889689448533090398996145_dp), & - (2.06742299986664055388985161698656149_dp, & - 0.723668357086202707062483341360348315_dp), & - (0.852514651480446872255924972705542983_dp, & - 0.789043817146060844081034701957833041_dp), & - (1.09098446025458177821576555288629603_dp, & - 1.48569478096399141264782883808948111_dp), & - (4.29633077423243321391055360436439499_dp, & - 0.338216396454583145825267820328008412_dp), & - (0.340462754402863337910289942556119029_dp, & - 0.172319442815022222381671213042864120_dp), & - (6.932352666201882229746189523211795805E-0002_dp, & - 6.742518436285274002761624956292507704E-0002_dp), & - (1.03231628501970258415809666985296648_dp, & - 0.421413014732743429480166241773986277_dp)] - - print *, "Test exponential_distribution_rvs_cdp" - seed = 593742186 - call random_seed(seed, get) - scale = (0.7_dp, 1.3_dp) - do i = 1, 5 - res(i) = expon_rvs(scale) - end do - res(6:10) = expon_rvs(scale, k) - call check(all(abs(res - ans) < dptol), & - msg="exponential_distribution_rvs_cdp failed", warn=warn) - end subroutine test_expon_rvs_cdp - - subroutine test_expon_rvs_cqp - complex(qp) :: res(10), scale - integer :: i, n, k = 5 - integer :: seed, get - complex(qp) :: ans(10) = [(0.640164505354053137153869101894088070_qp, & - 0.268204995991944639133208738712710328_qp), & - (0.141667583643866407117073435983911608_qp, & - 2.60843818343998017361684560455614716_qp), & - (0.116705911955157926040982374615850854_qp, & - 1.04120572522889689448533090398996145_qp), & - (2.06742299986664055388985161698656149_qp, & - 0.723668357086202707062483341360348315_qp), & - (0.852514651480446872255924972705542983_qp, & - 0.789043817146060844081034701957833041_qp), & - (1.09098446025458177821576555288629603_qp, & - 1.48569478096399141264782883808948111_qp), & - (4.29633077423243321391055360436439499_qp, & - 0.338216396454583145825267820328008412_qp), & - (0.340462754402863337910289942556119029_qp, & - 0.172319442815022222381671213042864120_qp), & - (6.932352666201882229746189523211795805E-0002_qp, & - 6.742518436285274002761624956292507704E-0002_qp), & - (1.03231628501970258415809666985296648_qp, & - 0.421413014732743429480166241773986277_qp)] - - print *, "Test exponential_distribution_rvs_cqp" - seed = 593742186 - call random_seed(seed, get) - scale = (0.7_qp, 1.3_qp) - do i = 1, 5 - res(i) = expon_rvs(scale) - end do - res(6:10) = expon_rvs(scale, k) - call check(all(abs(res - ans) < qptol), & - msg="exponential_distribution_rvs_cqp failed", warn=warn) - end subroutine test_expon_rvs_cqp - - - - subroutine test_expon_pdf_rsp - real(sp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [6.14960417E-02, 6.14960417E-02, 6.14960417E-02, & - 1.38718796, 0.729365528, 1.67107172E-02, 0.296734482,& - 2.36971565E-02, 4.06475700E-02, 1.18497872, & - 8.39852914E-02, 1.36920142, 1.54058458E-02, & - 3.20194475E-02, 0.603879571] - - print *, "Test exponential_distribution_pdf_rsp" - seed = 123987654 - call random_seed(seed, get) - scale = 1.5_sp - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_pdf(x1, scale) - res(:, 2:5) = expon_pdf(x2, scale) - call check(all(abs(res - reshape(ans, [3,5])) < sptol), & - msg="exponential_distribution_pdf_rsp failed", warn=warn) - end subroutine test_expon_pdf_rsp - - subroutine test_expon_pdf_rdp - real(dp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [6.14960417E-02, 6.14960417E-02, 6.14960417E-02, & - 1.38718796, 0.729365528, 1.67107172E-02, 0.296734482,& - 2.36971565E-02, 4.06475700E-02, 1.18497872, & - 8.39852914E-02, 1.36920142, 1.54058458E-02, & - 3.20194475E-02, 0.603879571] - - print *, "Test exponential_distribution_pdf_rdp" - seed = 123987654 - call random_seed(seed, get) - scale = 1.5_dp - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_pdf(x1, scale) - res(:, 2:5) = expon_pdf(x2, scale) - call check(all(abs(res - reshape(ans, [3,5])) < dptol), & - msg="exponential_distribution_pdf_rdp failed", warn=warn) - end subroutine test_expon_pdf_rdp - - subroutine test_expon_pdf_rqp - real(qp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [6.14960417E-02, 6.14960417E-02, 6.14960417E-02, & - 1.38718796, 0.729365528, 1.67107172E-02, 0.296734482,& - 2.36971565E-02, 4.06475700E-02, 1.18497872, & - 8.39852914E-02, 1.36920142, 1.54058458E-02, & - 3.20194475E-02, 0.603879571] - - print *, "Test exponential_distribution_pdf_rqp" - seed = 123987654 - call random_seed(seed, get) - scale = 1.5_qp - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_pdf(x1, scale) - res(:, 2:5) = expon_pdf(x2, scale) - call check(all(abs(res - reshape(ans, [3,5])) < qptol), & - msg="exponential_distribution_pdf_rqp failed", warn=warn) - end subroutine test_expon_pdf_rqp - - subroutine test_expon_pdf_csp - complex(sp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.386471182, 0.386471182,0.386471182,2.79592793E-03, & - 4.01333207E-03, 0.317740440, 0.385551631, & - 5.02163777E-03, 0.372386932, 6.09764457E-03, & - 0.273956627, 0.407586545, 1.59074657E-03, & - 0.136133000, 0.399842113] - - print *, "Test exponential_distribution_pdf_csp" - seed = 123987654 - call random_seed(seed, get) - scale = (0.3_sp, 1.6_sp) - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_pdf(x1, scale) - res(:, 2:5) = expon_pdf(x2, scale) - call check(all(abs(res - reshape(ans, [3,5])) < sptol), & - msg="exponential_distribution_pdf_csp failed", warn=warn) - end subroutine test_expon_pdf_csp - - subroutine test_expon_pdf_cdp - complex(dp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.386471182, 0.386471182,0.386471182,2.79592793E-03, & - 4.01333207E-03, 0.317740440, 0.385551631, & - 5.02163777E-03, 0.372386932, 6.09764457E-03, & - 0.273956627, 0.407586545, 1.59074657E-03, & - 0.136133000, 0.399842113] - - print *, "Test exponential_distribution_pdf_cdp" - seed = 123987654 - call random_seed(seed, get) - scale = (0.3_dp, 1.6_dp) - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_pdf(x1, scale) - res(:, 2:5) = expon_pdf(x2, scale) - call check(all(abs(res - reshape(ans, [3,5])) < dptol), & - msg="exponential_distribution_pdf_cdp failed", warn=warn) - end subroutine test_expon_pdf_cdp - - subroutine test_expon_pdf_cqp - complex(qp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.386471182, 0.386471182,0.386471182,2.79592793E-03, & - 4.01333207E-03, 0.317740440, 0.385551631, & - 5.02163777E-03, 0.372386932, 6.09764457E-03, & - 0.273956627, 0.407586545, 1.59074657E-03, & - 0.136133000, 0.399842113] - - print *, "Test exponential_distribution_pdf_cqp" - seed = 123987654 - call random_seed(seed, get) - scale = (0.3_qp, 1.6_qp) - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_pdf(x1, scale) - res(:, 2:5) = expon_pdf(x2, scale) - call check(all(abs(res - reshape(ans, [3,5])) < qptol), & - msg="exponential_distribution_pdf_cqp failed", warn=warn) - end subroutine test_expon_pdf_cqp - - - subroutine test_expon_cdf_rsp - real(sp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.370481908, 0.370481908, 0.370481908, 0.993631542, & - 0.246292457, 0.497423291, 0.999946773, 0.995101511, & - 0.305115670, 0.932980001, 0.967154086, 0.777015686, & - 0.983209372, 8.37164521E-02, 0.275721848] - - print *, "Test exponential_distribution_cdf_rsp" - seed = 621957438 - call random_seed(seed, get) - - scale = 2.0_sp - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_cdf(x1, scale) - res(:, 2:5) = expon_cdf(x2, scale) - call check(all(abs(res - reshape(ans,[3,5])) < sptol), & - msg="exponential_distribution_cdf_rsp failed", warn=warn) - end subroutine test_expon_cdf_rsp - - subroutine test_expon_cdf_rdp - real(dp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.370481908, 0.370481908, 0.370481908, 0.993631542, & - 0.246292457, 0.497423291, 0.999946773, 0.995101511, & - 0.305115670, 0.932980001, 0.967154086, 0.777015686, & - 0.983209372, 8.37164521E-02, 0.275721848] - - print *, "Test exponential_distribution_cdf_rdp" - seed = 621957438 - call random_seed(seed, get) - - scale = 2.0_dp - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_cdf(x1, scale) - res(:, 2:5) = expon_cdf(x2, scale) - call check(all(abs(res - reshape(ans,[3,5])) < dptol), & - msg="exponential_distribution_cdf_rdp failed", warn=warn) - end subroutine test_expon_cdf_rdp - - subroutine test_expon_cdf_rqp - real(qp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.370481908, 0.370481908, 0.370481908, 0.993631542, & - 0.246292457, 0.497423291, 0.999946773, 0.995101511, & - 0.305115670, 0.932980001, 0.967154086, 0.777015686, & - 0.983209372, 8.37164521E-02, 0.275721848] - - print *, "Test exponential_distribution_cdf_rqp" - seed = 621957438 - call random_seed(seed, get) - - scale = 2.0_qp - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_cdf(x1, scale) - res(:, 2:5) = expon_cdf(x2, scale) - call check(all(abs(res - reshape(ans,[3,5])) < qptol), & - msg="exponential_distribution_cdf_rqp failed", warn=warn) - end subroutine test_expon_cdf_rqp - - subroutine test_expon_cdf_csp - complex(sp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.176930442, 0.176930442, 0.176930442,5.98644912E-02,& - 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& - 0.118341751, 0.484595388, 0.794088185, 0.912919402, & - 0.914170802, 0.370377690, 0.793968141] - - print *, "Test exponential_distribution_cdf_csp" - seed = 621957438 - call random_seed(seed, get) - - scale = (1.3_sp, 2.1_sp) - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_cdf(x1, scale) - res(:, 2:5) = expon_cdf(x2, scale) - call check(all(abs(res - reshape(ans,[3,5])) < sptol), & - msg="exponential_distribution_cdf_csp failed", warn=warn) - end subroutine test_expon_cdf_csp - - subroutine test_expon_cdf_cdp - complex(dp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.176930442, 0.176930442, 0.176930442,5.98644912E-02,& - 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& - 0.118341751, 0.484595388, 0.794088185, 0.912919402, & - 0.914170802, 0.370377690, 0.793968141] - - print *, "Test exponential_distribution_cdf_cdp" - seed = 621957438 - call random_seed(seed, get) - - scale = (1.3_dp, 2.1_dp) - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_cdf(x1, scale) - res(:, 2:5) = expon_cdf(x2, scale) - call check(all(abs(res - reshape(ans,[3,5])) < dptol), & - msg="exponential_distribution_cdf_cdp failed", warn=warn) - end subroutine test_expon_cdf_cdp - - subroutine test_expon_cdf_cqp - complex(qp) :: x1, x2(3,4), scale - integer :: i, n - integer :: seed, get - real :: res(3,5) - real :: ans(15) = [0.176930442, 0.176930442, 0.176930442,5.98644912E-02,& - 0.981560826, 0.135309443, 0.617795825,7.55468532E-02,& - 0.118341751, 0.484595388, 0.794088185, 0.912919402, & - 0.914170802, 0.370377690, 0.793968141] - - print *, "Test exponential_distribution_cdf_cqp" - seed = 621957438 - call random_seed(seed, get) - - scale = (1.3_qp, 2.1_qp) - x1 = expon_rvs(scale) - x2 = reshape(expon_rvs(scale, 12), [3,4]) - res(:,1) = expon_cdf(x1, scale) - res(:, 2:5) = expon_cdf(x2, scale) - call check(all(abs(res - reshape(ans,[3,5])) < qptol), & - msg="exponential_distribution_cdf_cqp failed", warn=warn) - end subroutine test_expon_cdf_cqp - -end program test_distribution_expon \ No newline at end of file diff --git a/src/tests/stats/test_distribution_exponential.fypp b/src/tests/stats/test_distribution_exponential.fypp new file mode 100644 index 000000000..a59fdc28f --- /dev/null +++ b/src/tests/stats/test_distribution_exponential.fypp @@ -0,0 +1,276 @@ + +#:include "common.fypp" +#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES +program test_distribution_expon + use stdlib_kinds, only : sp, dp, xdp, qp + use stdlib_error, only : check + use stdlib_random, only : random_seed + use stdlib_stats_distribution_exponential, only : expon_rvs => rvs_expon, & + expon_pdf => pdf_expon, expon_cdf => cdf_expon + + implicit none + #:for k1, t1 in REAL_KINDS_TYPES + ${t1}$, parameter :: ${k1}$tol = 1000 * epsilon(1.0_${k1}$) + #:endfor + logical :: warn = .true. + integer :: put, get + + put = 12345678 + call random_seed(put, get) + + + call test_exponential_random_generator + + + #:for k1, t1 in RC_KINDS_TYPES + call test_expon_rvs_${t1[0]}$${k1}$ + #:endfor + + + #:for k1, t1 in RC_KINDS_TYPES + call test_expon_pdf_${t1[0]}$${k1}$ + #:endfor + call test_expon_pdf_rsp + + + #:for k1, t1 in RC_KINDS_TYPES + call test_expon_cdf_${t1[0]}$${k1}$ + #:endfor + + + + + +contains + + subroutine test_exponential_random_generator + + integer, parameter :: num = 10000000, array_size = 1000 + integer :: i, j, freq(0:array_size) + real(dp) :: chisq, expct + + print *, "" + print *, "Test exponential random generator with chi-squared" + freq = 0 + do i = 1, num + j = 1000 * (1 - exp(- expon_rvs(1.0))) + freq(j) = freq(j) + 1 + end do + chisq = 0.0_dp + expct = num / array_size + do i = 0, array_size - 1 + chisq = chisq + (freq(i) - expct) ** 2 / expct + end do + write(*,*) "The critical values for chi-squared with 1000 d. of f. is" & + //" 1143.92" + write(*,*) "Chi-squared for exponential random generator is : ", chisq + call check((chisq < 1143.9), & + msg="exponential randomness failed chi-squared test", warn=warn) + end subroutine test_exponential_random_generator + + + + #:for k1, t1 in RC_KINDS_TYPES + subroutine test_expon_rvs_${t1[0]}$${k1}$ + ${t1}$ :: res(10), scale + integer, parameter :: k = 5 + integer :: i, n + integer :: seed, get + #:if t1[0] == "r" + #! for real type + ${t1}$, parameter :: ans(10) = & + [0.609680481289574416337018192280083895_${k1}$, & + 0.137541023585612635452927558314210417_${k1}$, & + 0.134921508232253721063879462841820585_${k1}$, & + 1.33766060689229752493171569464417802_${k1}$, & + 0.111148487576340881943792737729381770_${k1}$, & + 0.533951653963536868966836361020492979_${k1}$, & + 1.96897428558727671799033487332053483_${k1}$, & + 0.371111977992924465160247867364281152_${k1}$, & + 0.811918715695663687862785688290993341_${k1}$, & + 0.404637854946697868759504975362991277_${k1}$] + #:else + #! for complex type + ${t1}$, parameter :: ans(10) = & + [(1.30645817419194517786503898345732266_${k1}$, & + 0.158701181060322271676454874977935106_${k1}$), & + (0.289117517640543687994027420375329869_${k1}$, & + 1.54345454641418945184428733997405138_${k1}$), & + (0.238175330520730461308127295134389521_${k1}$, & + 0.616098062265619464192503493485184250_${k1}$), & + (4.21923061197273582426500329997257485_${k1}$, & + 0.428206128453374382877209077728016710_${k1}$), & + (1.73982581934785075970596933205212874_${k1}$, & + 0.466889832630805233184044202341912994_${k1}$), & + (2.22649889847873832288931745486999202_${k1}$, & + 0.879109337848515628785697537331053851_${k1}$), & + (8.76802198822945553859296653951917464_${k1}$, & + 0.200128045239398311139211728004738688_${k1}$), & + (0.694821947760945587572020290930855262_${k1}$, & + 0.101964167346166995492113143812345625_${k1}$), & + (0.141476585024528208770330398432893829_${k1}$, & + 3.989655879458742013468417133900891716E-0002_${k1}$), & + (2.10676792861163792685325850990401309_${k1}$, & + 0.249356813451327473065187125310051027_${k1}$)] + #:endif + + print *, "Test exponential_distribution_rvs_${t1[0]}$${k1}$" + seed = 593742186 + call random_seed(seed, get) + + #:if t1[0] == "r" + #! for real type + scale = 1.5_${k1}$ + #:else + #! for complex type + scale = (0.7_${k1}$, 1.3_${k1}$) + #:endif + + do i = 1, k + res(i) = expon_rvs(scale) ! 1 dummy + end do + res(6:10) = expon_rvs(scale, k) ! 2 dummies + call check(all(abs(res - ans) < ${k1}$tol), & + msg="exponential_distribution_rvs_${t1[0]}$${k1}$ failed", warn=warn) + end subroutine test_expon_rvs_${t1[0]}$${k1}$ + + #:endfor + + + + + #:for k1, t1 in RC_KINDS_TYPES + subroutine test_expon_pdf_${t1[0]}$${k1}$ + + ${t1}$ :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real(${k1}$) :: res(3,5) + #:if t1[0] == "r" + #! for real type + real(${k1}$), parameter :: ans(15) = & + [0.362692289054629718342313806171796533_${k1}$, & + 0.362692289054629718342313806171796533_${k1}$, & + 0.362692289054629718342313806171796533_${k1}$, & + 1.44877092399186122284289290051705535_${k1}$, & + 1.08871761038277651996081144393335589_${k1}$, & + 0.203258408490339213767867275283195750_${k1}$, & + 0.730004225568590859263284124264208147_${k1}$, & + 0.237394827760488451509080387833146683_${k1}$, & + 0.301732182586179598102005265289645959_${k1}$, & + 1.35079274124711914255014934401469271_${k1}$, & + 0.416578245043239337295928202660090263_${k1}$, & + 1.44039177901335374382803898226703593_${k1}$, & + 0.196044829271295768265275728683411055_${k1}$, & + 0.271373826917613661285112379170965958_${k1}$, & + 1.00108987409617105109732206933052664_${k1}$] + #:else + #! for complex type + real(${k1}$), parameter :: ans(15) = & + [0.112097715784191810518066563334849515_${k1}$, & + 0.112097715784191810518066563334849515_${k1}$, & + 0.112097715784191810518066563334849515_${k1}$, & + 4.72087485401191174735651518020251204E-0002_${k1}$, & + 3.69705018439006691768174449531170720E-0002_${k1}$, & + 8.69498969681198520061798177185735738E-0002_${k1}$, & + 0.128007654288233028296342302153338001_${k1}$, & + 1.13496395875758374774198906169957218E-0002_${k1}$, & + 0.294260498264128747413785056084385424_${k1}$, & + 4.66169813179250908948018478030960097E-0002_${k1}$, & + 2.84438693906889813143446828488861951E-0002_${k1}$, & + 0.161859307815385236742977105439660254_${k1}$, & + 4.22904796362406579112752522035325397E-0002_${k1}$, & + 0.176117981883470250164040199296778089_${k1}$, & + 0.107352342201327219885025541854724060_${k1}$] + #:endif + + print *, "Test exponential_distribution_pdf_${t1[0]}$${k1}$" + seed = 123987654 + call random_seed(seed, get) + #:if t1[0] == "r" + #! for real type + scale = 1.5_${k1}$ + #:else + #! for complex type + scale = (0.3_${k1}$, 1.6_${k1}$) + #:endif + + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_pdf(x1, scale) + res(:, 2:5) = expon_pdf(x2, scale) + call check(all(abs(res - reshape(ans, [3,5])) < ${k1}$tol), & + msg="exponential_distribution_pdf_${t1[0]}$${k1}$ failed", warn=warn) + end subroutine test_expon_pdf_${t1[0]}$${k1}$ + + #:endfor + + + + + #:for k1, t1 in RC_KINDS_TYPES + subroutine test_expon_cdf_${t1[0]}$${k1}$ + + ${t1}$ :: x1, x2(3,4), scale + integer :: i, n + integer :: seed, get + real(${k1}$) :: res(3,5) + #:if t1[0] == "r" + #! for real type + real(${k1}$), parameter :: ans(15) = & + [0.109257742653704886153815776449785051_${k1}$, & + 0.109257742653704886153815776449785051_${k1}$, & + 0.109257742653704886153815776449785051_${k1}$, & + 0.717506371795765265795319089684216215_${k1}$, & + 6.82471795435370961628021592837348251E-0002_${k1}$, & + 0.158022297254037860379992220663140220_${k1}$, & + 0.914579543576380160727189390750289231_${k1}$, & + 0.735445094339121647068624074363021598_${k1}$, & + 8.69845458684957375690771394578441361E-0002_${k1}$, & + 0.491195342629961409581199224477971938_${k1}$, & + 0.574283568793105916250099261345264380_${k1}$, & + 0.312823040527767907760475800138803955_${k1}$, & + 0.640029783598040153827956625977856239_${k1}$, & + 2.16202116731629451897815202649346917E-0002_${k1}$, & + 7.74788145547936974757767867581111655E-0002_${k1}$] + #:else + real(${k1}$), parameter :: ans(15) = & + [7.83931265220552191922145459533155073E-0002_${k1}$, & + 7.83931265220552191922145459533155073E-0002_${k1}$, & + 7.83931265220552191922145459533155073E-0002_${k1}$, & + 1.07845760925785109085652212151328215E-0002_${k1}$, & + 0.672623038706161724678635394849362256_${k1}$, & + 4.27264038113873579678831482902258168E-0002_${k1}$, & + 0.179649132114996961326498233168917293_${k1}$, & + 1.38375793985183014482681114776428612E-0002_${k1}$, & + 3.49246365297941076158369468479748612E-0002_${k1}$, & + 0.116869945417176368845403154176734792_${k1}$, & + 0.468462732010133566674397830557697485_${k1}$, & + 0.413506985517976634907329948218002431_${k1}$, & + 0.665679674838121942273909342901808398_${k1}$, & + 0.223748595107983772617787558595393205_${k1}$, & + 0.337722969540396286456937689606849800_${k1}$] + #:endif + + print *, "Test exponential_distribution_cdf_${t1[0]}$${k1}$" + seed = 621957438 + call random_seed(seed, get) + + #:if t1[0] == "r" + #! for real type + scale = 2.0_${k1}$ + #:else + scale = (1.3_${k1}$, 2.1_${k1}$) + #:endif + + x1 = expon_rvs(scale) + x2 = reshape(expon_rvs(scale, 12), [3,4]) + res(:,1) = expon_cdf(x1, scale) + res(:, 2:5) = expon_cdf(x2, scale) + call check(all(abs(res - reshape(ans,[3,5])) < ${k1}$tol), & + msg="exponential_distribution_cdf_${t1[0]}$${k1}$ failed", warn=warn) + end subroutine test_expon_cdf_${t1[0]}$${k1}$ + + #:endfor + +end program test_distribution_expon From 833c2a7809f3fb02c29ecd04539e5b4c021daead Mon Sep 17 00:00:00 2001 From: jim-215-fisher Date: Sun, 12 Dec 2021 17:13:01 -0500 Subject: [PATCH 44/55] correct makefile --- src/tests/stats/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/stats/Makefile.manual b/src/tests/stats/Makefile.manual index 5650103ed..23c027dbf 100644 --- a/src/tests/stats/Makefile.manual +++ b/src/tests/stats/Makefile.manual @@ -3,7 +3,7 @@ SRCFYPP = \ test_median.fypp \ test_distribution_uniform.fypp \ test_distribution_normal.fypp \ - test_distribution_exponential + test_distribution_exponential.fypp SRCGEN = $(SRCFYPP:.fypp=.f90) From 47e63d2ba9a49a13096b0d8d01e1770951ac57f3 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 19 Dec 2021 12:35:42 -0500 Subject: [PATCH 45/55] Update src/stdlib_stats_distribution_exponential.fypp Co-authored-by: Jeremie Vandenplas --- src/stdlib_stats_distribution_exponential.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_stats_distribution_exponential.fypp b/src/stdlib_stats_distribution_exponential.fypp index 56b877bdf..8300d6533 100644 --- a/src/stdlib_stats_distribution_exponential.fypp +++ b/src/stdlib_stats_distribution_exponential.fypp @@ -21,7 +21,7 @@ module stdlib_stats_distribution_exponential interface rvs_expon - !! Version experimental + !! Version: experimental !! !! Exponential Distribution Random Variates !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# From b77ec62d336313f906ab6173c8637772d00182dc Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 19 Dec 2021 12:35:48 -0500 Subject: [PATCH 46/55] Update src/stdlib_stats_distribution_exponential.fypp Co-authored-by: Jeremie Vandenplas --- src/stdlib_stats_distribution_exponential.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_stats_distribution_exponential.fypp b/src/stdlib_stats_distribution_exponential.fypp index 8300d6533..96c4f0f1f 100644 --- a/src/stdlib_stats_distribution_exponential.fypp +++ b/src/stdlib_stats_distribution_exponential.fypp @@ -41,7 +41,7 @@ module stdlib_stats_distribution_exponential interface pdf_expon - !! Version experimental + !! Version: experimental !! !! Exponential Distribution Probability Density Function !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# From 59280d2d1d2919d79d8026b7b46ffe3ee02091fe Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 19 Dec 2021 12:35:56 -0500 Subject: [PATCH 47/55] Update src/stdlib_stats_distribution_exponential.fypp Co-authored-by: Jeremie Vandenplas --- src/stdlib_stats_distribution_exponential.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_stats_distribution_exponential.fypp b/src/stdlib_stats_distribution_exponential.fypp index 96c4f0f1f..8f4082bc1 100644 --- a/src/stdlib_stats_distribution_exponential.fypp +++ b/src/stdlib_stats_distribution_exponential.fypp @@ -55,7 +55,7 @@ module stdlib_stats_distribution_exponential interface cdf_expon - !! Version experimental + !! Version: experimental !! !! Exponential Distribution Cumulative Distribution Function !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# From ff0da265f5fcf285ce04e15a09625edaefecf51c Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 19 Dec 2021 12:36:03 -0500 Subject: [PATCH 48/55] Update src/stdlib_stats_distribution_exponential.fypp Co-authored-by: Jeremie Vandenplas --- src/stdlib_stats_distribution_exponential.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_stats_distribution_exponential.fypp b/src/stdlib_stats_distribution_exponential.fypp index 8f4082bc1..2c99ad8fe 100644 --- a/src/stdlib_stats_distribution_exponential.fypp +++ b/src/stdlib_stats_distribution_exponential.fypp @@ -76,7 +76,7 @@ contains ! Marsaglia & Tsang generator for random normals & random exponentials. ! Translated from C by Alan Miller (amiller@bigpond.net.au) ! - ! Marsaglia, G. & Tsang, W.W. (2000) `The ziggurat method for generating + ! Marsaglia, G. & Tsang, W.W. (2000) 'The ziggurat method for generating ! random variables', J. Statist. Software, v5(8). ! ! This is an electronic journal which can be downloaded from: From 212bc33dd7b1f43a59a8d904c6a17a1e4aae3eab Mon Sep 17 00:00:00 2001 From: jim-215-fisher Date: Wed, 22 Dec 2021 10:53:39 -0500 Subject: [PATCH 49/55] convert expon name to exp and some words change --- .../stdlib_stats_distribution_exponential.md | 38 +++---- ...stdlib_stats_distribution_exponential.fypp | 104 +++++++++--------- .../stats/test_distribution_exponential.fypp | 4 +- 3 files changed, 73 insertions(+), 73 deletions(-) diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md index 72e6ffe9c..43e05b857 100644 --- a/doc/specs/stdlib_stats_distribution_exponential.md +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -6,7 +6,7 @@ title: stats_distribution_exponential [TOC] -## `rvs_expon` - exponential distribution random variates +## `rvs_exp` - exponential distribution random variates ### Status @@ -14,19 +14,19 @@ Experimental ### Description -An exponentially distributed random variate distribution is the distribution of time between events in a Poisson point process. The inverse scale parameter `lambda` specifies the rate of change. +An exponential distribution is the distribution of time between events in a Poisson point process. The inverse scale parameter `lambda` specifies the average time between events, also called the rate of events. -Without argument the function returns a standard exponential distributed random variate E(1) with `lambda = 1`. +Without argument the function returns a random sample from the standard exponential distribution `E(1)` with `lambda = 1`. -With single argument, the function returns an exponential distributed random variate E(lambda). For complex arguments, the real and imaginary parts are independent of each other. +With single argument, the function returns a random sample from the exponential distribution `E(lambda)`. For complex arguments, the real and imaginary parts are independent of each other. -With two arguments the function returns a rank one array of exponential distributed random variates. +With two arguments the function returns a rank one array of exponentially distributed random variates. -Note: the algorithm used for generating normal random variates is fundamentally limited to double precision. +Note: the algorithm used for generating exponetial random variates is fundamentally limited to double precision. Ref.: Marsaglia, G. & Tsang, W.W. (2000) `The ziggurat method for generating random variables', J. Statist. Software, v5(8). ### Syntax -`result = [[stdlib_stats_distribution_exponential(module):rvs_expon(interface)]]([lambda] [[, array_size]])` +`result = [[stdlib_stats_distribution_exponential(module):rvs_exp(interface)]]([lambda] [[, array_size]])` ### Class @@ -34,7 +34,7 @@ Function ### Arguments -`lambda`: optional argument has `intent(in)` and is a scalar of type `real` or `complex`. +`lambda`: optional argument has `intent(in)` and is a scalar of type `real` or `complex`. The value of `lambda` has to be non-negative. `array_size`: optional argument has `intent(in)` and is a scalar of type `integer` with default kind. @@ -47,7 +47,7 @@ The result is a scalar or rank one array with a size of `array_size`, and as the ```fortran program demo_exponential_rvs use stdlib_random, only : random_seed - use stdlib_stats_distribution_exponential, only: rexp => rvs_expon + use stdlib_stats_distribution_exponential, only: rexp => rvs_exp implicit none real :: a(2,3,4) @@ -80,7 +80,7 @@ program demo_exponential_rvs end program demo_exponential_rvs ``` -## `pdf_expon` - exponential distribution probability density function +## `pdf_exp` - exponential distribution probability density function ### Status @@ -92,13 +92,13 @@ The probability density function (pdf) of the single real variable exponential d $$f(x)=\begin{cases} \lambda e^{-\lambda x} &x\geqslant 0 \\\\ 0 &x< 0\end{}$$ -For complex varible (x + y i) with independent real x and imaginary y parts, the joint probability density function is the product of corresponding marginal pdf of real and imaginary pdf (ref. "Probability and Random Processes with Applications to Signal Processing and Communications", 2nd ed., Scott L. Miller and Donald Childers, 2012, p.197): +For a complex varible (x + y i) with independent real x and imaginary y parts, the joint probability density function is the product of corresponding marginal pdf of real and imaginary pdf (ref. "Probability and Random Processes with Applications to Signal Processing and Communications", 2nd ed., Scott L. Miller and Donald Childers, 2012, p.197): $$f(x+\mathit{i}y)=f(x)f(y)=\begin{cases} \lambda_{x} \lambda_{y} e^{-(\lambda_{x} x + \lambda_{y} y)} &x\geqslant 0, y\geqslant 0 \\\\ 0 &otherwise\end{}$$ ### Syntax -`result = [[stdlib_stats_distribution_exponential(module):pdf_expon(interface)]](x, lambda)` +`result = [[stdlib_stats_distribution_exponential(module):pdf_exp(interface)]](x, lambda)` ### Class @@ -121,8 +121,8 @@ The result is a scalar or an array, with a shape conformable to arguments, and a ```fortran program demo_exponential_pdf use stdlib_random, only : random_seed - use stdlib_stats_distribution_exponential, only: exp_pdf => pdf_expon, & - rexp => rvs_expon + use stdlib_stats_distribution_exponential, only: exp_pdf => pdf_exp, & + rexp => rvs_exp implicit none real :: x(2,3,4),a(2,3,4) @@ -160,7 +160,7 @@ program demo_exponential_pdf end program demo_exponential_pdf ``` -## `cdf_expon` - exponential distribution cumulative distribution function +## `cdf_exp` - exponential distribution cumulative distribution function ### Status @@ -172,13 +172,13 @@ Cumulative distribution function (cdf) of the single real variable exponential d $$F(x)=\begin{cases}1 - e^{-\lambda x} &x\geqslant 0 \\\\ 0 &x< 0\end{}$$ -For the complex variable (x + y i) with independent real x and imaginary y parts, the joint cumulative distribution function is the product of corresponding marginal cdf of real and imaginary cdf (ref. "Probability and Random Processes with Applications to Signal Processing and Communications", 2nd ed., Scott L. Miller and Donald Childers, 2012, p.197): +For a complex variable (x + y i) with independent real x and imaginary y parts, the joint cumulative distribution function is the product of corresponding marginal cdf of real and imaginary cdf (ref. "Probability and Random Processes with Applications to Signal Processing and Communications", 2nd ed., Scott L. Miller and Donald Childers, 2012, p.197): $$F(x+\mathit{i}y)=F(x)F(y)=\begin{cases} (1 - e^{-\lambda_{x} x})(1 - e^{-\lambda_{y} y}) &x\geqslant 0, \;\; y\geqslant 0 \\\\ 0 &otherwise \end{}$$ ### Syntax -`result = [[stdlib_stats_distribution_exponential(module):cdf_expon(interface)]](x, lambda)` +`result = [[stdlib_stats_distribution_exponential(module):cdf_exp(interface)]](x, lambda)` ### Class @@ -201,8 +201,8 @@ The result is a scalar or an array, with a shape conformable to arguments, and a ```fortran program demo_exponential_cdf use stdlib_random, only : random_seed - use stdlib_stats_distribution_exponential, only : exp_cdf => cdf_expon, & - rexp => rvs_expon + use stdlib_stats_distribution_exponential, only : exp_cdf => cdf_exp, & + rexp => rvs_exp implicit none real :: x(2,3,4),a(2,3,4) diff --git a/src/stdlib_stats_distribution_exponential.fypp b/src/stdlib_stats_distribution_exponential.fypp index 56b877bdf..e4ebdf221 100644 --- a/src/stdlib_stats_distribution_exponential.fypp +++ b/src/stdlib_stats_distribution_exponential.fypp @@ -9,62 +9,61 @@ module stdlib_stats_distribution_exponential implicit none private - real(dp), parameter :: ONE = 1.0_dp integer :: ke(0:255) real(dp) :: we(0:255), fe(0:255) logical :: zig_exp_initialized = .false. - public :: rvs_expon - public :: pdf_expon - public :: cdf_expon + public :: rvs_exp + public :: pdf_exp + public :: cdf_exp - interface rvs_expon + interface rvs_exp !! Version experimental !! !! Exponential Distribution Random Variates !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# - !! rvs_expon-exponential-distribution-random-variates)) + !! rvs_exp-exponential-distribution-random-variates)) !! - module procedure rvs_expon_0_rsp !0 dummy variable + module procedure rvs_exp_0_rsp !0 dummy variable #:for k1, t1 in RC_KINDS_TYPES - module procedure rvs_expon_${t1[0]}$${k1}$ !1 dummy variable + module procedure rvs_exp_${t1[0]}$${k1}$ !1 dummy variable #:endfor #:for k1, t1 in RC_KINDS_TYPES - module procedure rvs_expon_array_${t1[0]}$${k1}$ !2 dummy variables + module procedure rvs_exp_array_${t1[0]}$${k1}$ !2 dummy variables #:endfor - end interface rvs_expon + end interface rvs_exp - interface pdf_expon + interface pdf_exp !! Version experimental !! !! Exponential Distribution Probability Density Function !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# - !! pdf_expon-exponential-distribution-probability-density-function)) + !! pdf_exp-exponential-distribution-probability-density-function)) !! #:for k1, t1 in RC_KINDS_TYPES - module procedure pdf_expon_${t1[0]}$${k1}$ + module procedure pdf_exp_${t1[0]}$${k1}$ #:endfor - end interface pdf_expon + end interface pdf_exp - interface cdf_expon + interface cdf_exp !! Version experimental !! !! Exponential Distribution Cumulative Distribution Function !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# - !! cdf_expon-exponential-distribution-cumulative-distribution-function)) + !! cdf_exp-exponential-distribution-cumulative-distribution-function)) !! #:for k1, t1 in RC_KINDS_TYPES - module procedure cdf_expon_${t1[0]}$${k1}$ + module procedure cdf_exp_${t1[0]}$${k1}$ #:endfor - end interface cdf_expon + end interface cdf_exp @@ -85,6 +84,7 @@ contains ! Latest version - 1 January 2001 ! real(dp), parameter :: M2 = 2147483648.0_dp, ve = 0.003949659822581572_dp + real(dp), parameter :: ONE = 1.0_dp real(dp) :: de, te, q integer :: i @@ -112,7 +112,7 @@ contains #:for k1, t1 in REAL_KINDS_TYPES - function rvs_expon_0_${t1[0]}$${k1}$( ) result(res) + function rvs_exp_0_${t1[0]}$${k1}$( ) result(res) ! ! Standard exponential random variate (lambda=1) ! @@ -145,7 +145,7 @@ contains end if end do L1 endif - end function rvs_expon_0_${t1[0]}$${k1}$ + end function rvs_exp_0_${t1[0]}$${k1}$ #:endfor @@ -153,7 +153,7 @@ contains #:for k1, t1 in REAL_KINDS_TYPES - function rvs_expon_${t1[0]}$${k1}$(lambda) result(res) + function rvs_exp_${t1[0]}$${k1}$(lambda) result(res) ! ! Exponential distributed random variate ! @@ -161,11 +161,11 @@ contains ${t1}$ :: res - if(lambda <= 0.0_${k1}$) call error_stop("Error(rvs_expon): Exponen" & + if(lambda <= 0.0_${k1}$) call error_stop("Error(rvs_exp): Exponen" & //"tial distribution lambda parameter must be greater than zero") - res = rvs_expon_0_${t1[0]}$${k1}$( ) + res = rvs_exp_0_${t1[0]}$${k1}$( ) res = res / lambda - end function rvs_expon_${t1[0]}$${k1}$ + end function rvs_exp_${t1[0]}$${k1}$ #:endfor @@ -173,15 +173,15 @@ contains #:for k1, t1 in CMPLX_KINDS_TYPES - function rvs_expon_${t1[0]}$${k1}$(lambda) result(res) + function rvs_exp_${t1[0]}$${k1}$(lambda) result(res) ${t1}$, intent(in) :: lambda ${t1}$ :: res real(${k1}$) :: tr, ti - tr = rvs_expon_r${k1}$(lambda % re) - ti = rvs_expon_r${k1}$(lambda % im) + tr = rvs_exp_r${k1}$(lambda % re) + ti = rvs_exp_r${k1}$(lambda % im) res = cmplx(tr, ti, kind=${k1}$) - end function rvs_expon_${t1[0]}$${k1}$ + end function rvs_exp_${t1[0]}$${k1}$ #:endfor @@ -189,15 +189,15 @@ contains #:for k1, t1 in REAL_KINDS_TYPES - function rvs_expon_array_${t1[0]}$${k1}$(lambda, array_size) result(res) + function rvs_exp_array_${t1[0]}$${k1}$(lambda, array_size) result(res) ${t1}$, intent(in) :: lambda integer, intent(in) :: array_size ${t1}$ :: res(array_size), x, re ${t1}$, parameter :: r = 7.69711747013104972_${k1}$ integer :: jz, iz, i - if(lambda <= 0.0_${k1}$) call error_stop("Error(rvs_expon_array): Exp" & - //"oonential distribution lambda parameter must be greater than zero") + if(lambda <= 0.0_${k1}$) call error_stop("Error(rvs_exp_array): Exp" & + //"onential distribution lambda parameter must be greater than zero") if(.not. zig_exp_initialized) call zigset do i = 1, array_size @@ -227,7 +227,7 @@ contains endif res(i) = re / lambda end do - end function rvs_expon_array_${t1[0]}$${k1}$ + end function rvs_exp_array_${t1[0]}$${k1}$ #:endfor @@ -235,7 +235,7 @@ contains #:for k1, t1 in CMPLX_KINDS_TYPES - function rvs_expon_array_${t1[0]}$${k1}$(lambda, array_size) result(res) + function rvs_exp_array_${t1[0]}$${k1}$(lambda, array_size) result(res) ${t1}$, intent(in) :: lambda integer, intent(in) :: array_size ${t1}$ :: res(array_size) @@ -243,11 +243,11 @@ contains real(${k1}$) :: tr, ti do i = 1, array_size - tr = rvs_expon_r${k1}$(lambda % re) - ti = rvs_expon_r${k1}$(lambda % im) + tr = rvs_exp_r${k1}$(lambda % re) + ti = rvs_exp_r${k1}$(lambda % im) res(i) = cmplx(tr, ti, kind=${k1}$) end do - end function rvs_expon_array_${t1[0]}$${k1}$ + end function rvs_exp_array_${t1[0]}$${k1}$ #:endfor @@ -255,19 +255,19 @@ contains #:for k1, t1 in REAL_KINDS_TYPES - impure elemental function pdf_expon_${t1[0]}$${k1}$(x, lambda) result(res) + impure elemental function pdf_exp_${t1[0]}$${k1}$(x, lambda) result(res) ! ! Exponential Distribution Probability Density Function ! ${t1}$, intent(in) :: x, lambda real(${k1}$) :: res - if(lambda <= 0.0_${k1}$) call error_stop("Error(pdf_expon): Expon" & + if(lambda <= 0.0_${k1}$) call error_stop("Error(pdf_exp): Expon" & //"ential distribution lambda parameter must be greater than zero") - if(x < 0.0_${k1}$) call error_stop("Error(pdf_expon): Exponential" & + if(x < 0.0_${k1}$) call error_stop("Error(pdf_exp): Exponential" & //" distribution variate x must be non-negative") res = exp(- x * lambda) * lambda - end function pdf_expon_${t1[0]}$${k1}$ + end function pdf_exp_${t1[0]}$${k1}$ #:endfor @@ -275,13 +275,13 @@ contains #:for k1, t1 in CMPLX_KINDS_TYPES - impure elemental function pdf_expon_${t1[0]}$${k1}$(x, lambda) result(res) + impure elemental function pdf_exp_${t1[0]}$${k1}$(x, lambda) result(res) ${t1}$, intent(in) :: x, lambda real(${k1}$) :: res - res = pdf_expon_r${k1}$(x % re, lambda % re) - res = res * pdf_expon_r${k1}$(x % im, lambda % im) - end function pdf_expon_${t1[0]}$${k1}$ + res = pdf_exp_r${k1}$(x % re, lambda % re) + res = res * pdf_exp_r${k1}$(x % im, lambda % im) + end function pdf_exp_${t1[0]}$${k1}$ #:endfor @@ -289,19 +289,19 @@ contains #:for k1, t1 in REAL_KINDS_TYPES - impure elemental function cdf_expon_${t1[0]}$${k1}$(x, lambda) result(res) + impure elemental function cdf_exp_${t1[0]}$${k1}$(x, lambda) result(res) ! ! Exponential Distribution Cumulative Distribution Function ! ${t1}$, intent(in) :: x, lambda real(${k1}$) :: res - if(lambda <= 0.0_${k1}$) call error_stop("Error(cdf_expon): Expon" & + if(lambda <= 0.0_${k1}$) call error_stop("Error(cdf_exp): Expon" & //"ential distribution lambda parameter must be greater than zero") - if(x < 0.0_${k1}$) call error_stop("Error(cdf_expon): Exponential" & + if(x < 0.0_${k1}$) call error_stop("Error(cdf_exp): Exponential" & //" distribution variate x must be non-negative") res = 1.0_${k1}$ - exp(- x * lambda) - end function cdf_expon_${t1[0]}$${k1}$ + end function cdf_exp_${t1[0]}$${k1}$ #:endfor @@ -309,13 +309,13 @@ contains #:for k1, t1 in CMPLX_KINDS_TYPES - impure elemental function cdf_expon_${t1[0]}$${k1}$(x, lambda) result(res) + impure elemental function cdf_exp_${t1[0]}$${k1}$(x, lambda) result(res) ${t1}$, intent(in) :: x, lambda real(${k1}$) :: res - res = cdf_expon_r${k1}$(x % re, lambda % re) - res = res * cdf_expon_r${k1}$(x % im, lambda % im) - end function cdf_expon_${t1[0]}$${k1}$ + res = cdf_exp_r${k1}$(x % re, lambda % re) + res = res * cdf_exp_r${k1}$(x % im, lambda % im) + end function cdf_exp_${t1[0]}$${k1}$ #:endfor diff --git a/src/tests/stats/test_distribution_exponential.fypp b/src/tests/stats/test_distribution_exponential.fypp index a59fdc28f..95dc998c1 100644 --- a/src/tests/stats/test_distribution_exponential.fypp +++ b/src/tests/stats/test_distribution_exponential.fypp @@ -5,8 +5,8 @@ program test_distribution_expon use stdlib_kinds, only : sp, dp, xdp, qp use stdlib_error, only : check use stdlib_random, only : random_seed - use stdlib_stats_distribution_exponential, only : expon_rvs => rvs_expon, & - expon_pdf => pdf_expon, expon_cdf => cdf_expon + use stdlib_stats_distribution_exponential, only : expon_rvs => rvs_exp, & + expon_pdf => pdf_exp, expon_cdf => cdf_exp implicit none #:for k1, t1 in REAL_KINDS_TYPES From 8c9fff13fd5a1cc906dcd498f811eb0579db27e0 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 26 Dec 2021 10:39:11 -0500 Subject: [PATCH 50/55] Update doc/specs/stdlib_stats_distribution_exponential.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_stats_distribution_exponential.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md index 43e05b857..4b3ef816b 100644 --- a/doc/specs/stdlib_stats_distribution_exponential.md +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -18,7 +18,8 @@ An exponential distribution is the distribution of time between events in a Pois Without argument the function returns a random sample from the standard exponential distribution `E(1)` with `lambda = 1`. -With single argument, the function returns a random sample from the exponential distribution `E(lambda)`. For complex arguments, the real and imaginary parts are independent of each other. +With a single argument, the function returns a random sample from the exponential distribution `E(lambda)`. +For complex arguments, the real and imaginary parts are sampled independently of each other. With two arguments the function returns a rank one array of exponentially distributed random variates. From 93655f669b01de3a8a1ef52d8d2185e2837c5965 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 26 Dec 2021 10:40:12 -0500 Subject: [PATCH 51/55] Update doc/specs/stdlib_stats_distribution_exponential.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_stats_distribution_exponential.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md index 4b3ef816b..a3a2e353c 100644 --- a/doc/specs/stdlib_stats_distribution_exponential.md +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -93,7 +93,9 @@ The probability density function (pdf) of the single real variable exponential d $$f(x)=\begin{cases} \lambda e^{-\lambda x} &x\geqslant 0 \\\\ 0 &x< 0\end{}$$ -For a complex varible (x + y i) with independent real x and imaginary y parts, the joint probability density function is the product of corresponding marginal pdf of real and imaginary pdf (ref. "Probability and Random Processes with Applications to Signal Processing and Communications", 2nd ed., Scott L. Miller and Donald Childers, 2012, p.197): +For a complex variable (x + y i) with independent real x and imaginary y parts, the joint probability density function +is the product of the corresponding marginal pdf of real and imaginary pdf (for more details, see +"Probability and Random Processes with Applications to Signal Processing and Communications", 2nd ed., Scott L. Miller and Donald Childers, 2012, p.197): $$f(x+\mathit{i}y)=f(x)f(y)=\begin{cases} \lambda_{x} \lambda_{y} e^{-(\lambda_{x} x + \lambda_{y} y)} &x\geqslant 0, y\geqslant 0 \\\\ 0 &otherwise\end{}$$ From 18cc7aefe38d1f8ca1a99970f2751fc5ecefdb20 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 26 Dec 2021 10:40:47 -0500 Subject: [PATCH 52/55] Update doc/specs/stdlib_stats_distribution_exponential.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_stats_distribution_exponential.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md index a3a2e353c..7450fb455 100644 --- a/doc/specs/stdlib_stats_distribution_exponential.md +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -163,7 +163,7 @@ program demo_exponential_pdf end program demo_exponential_pdf ``` -## `cdf_exp` - exponential distribution cumulative distribution function +## `cdf_exp` - exponential cumulative distribution function ### Status From a330f31c4be81161d0c693633287f9fb87f64f45 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 26 Dec 2021 10:41:27 -0500 Subject: [PATCH 53/55] Update doc/specs/stdlib_stats_distribution_exponential.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_stats_distribution_exponential.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md index 7450fb455..22c490567 100644 --- a/doc/specs/stdlib_stats_distribution_exponential.md +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -175,7 +175,9 @@ Cumulative distribution function (cdf) of the single real variable exponential d $$F(x)=\begin{cases}1 - e^{-\lambda x} &x\geqslant 0 \\\\ 0 &x< 0\end{}$$ -For a complex variable (x + y i) with independent real x and imaginary y parts, the joint cumulative distribution function is the product of corresponding marginal cdf of real and imaginary cdf (ref. "Probability and Random Processes with Applications to Signal Processing and Communications", 2nd ed., Scott L. Miller and Donald Childers, 2012, p.197): +For a complex variable (x + y i) with independent real x and imaginary y parts, the joint cumulative distribution +function is the product of corresponding marginal cdf of real and imaginary cdf (for more details, see +"Probability and Random Processes with Applications to Signal Processing and Communications", 2nd ed., Scott L. Miller and Donald Childers, 2012, p.197): $$F(x+\mathit{i}y)=F(x)F(y)=\begin{cases} (1 - e^{-\lambda_{x} x})(1 - e^{-\lambda_{y} y}) &x\geqslant 0, \;\; y\geqslant 0 \\\\ 0 &otherwise \end{}$$ From db5c109a228217bdd1cdf3ce069e36d8103e1070 Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Sun, 26 Dec 2021 10:42:15 -0500 Subject: [PATCH 54/55] Update src/stdlib_stats_distribution_exponential.fypp Co-authored-by: Jeremie Vandenplas --- src/stdlib_stats_distribution_exponential.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_stats_distribution_exponential.fypp b/src/stdlib_stats_distribution_exponential.fypp index 34a5ee144..01d4e8eb8 100644 --- a/src/stdlib_stats_distribution_exponential.fypp +++ b/src/stdlib_stats_distribution_exponential.fypp @@ -56,7 +56,7 @@ module stdlib_stats_distribution_exponential interface cdf_exp !! Version experimental !! - !! Exponential Distribution Cumulative Distribution Function + !! Exponential Cumulative Distribution Function !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# !! cdf_exp-exponential-distribution-cumulative-distribution-function)) !! From 15dd737fb4228d777cec9e27bda4ad7932c90e2c Mon Sep 17 00:00:00 2001 From: Jing <53905783+Jim-215-Fisher@users.noreply.github.com> Date: Tue, 28 Dec 2021 09:14:54 -0500 Subject: [PATCH 55/55] minor wording change --- doc/specs/stdlib_stats_distribution_exponential.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md index 22c490567..9a53bee95 100644 --- a/doc/specs/stdlib_stats_distribution_exponential.md +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -41,7 +41,7 @@ Function ### Return value -The result is a scalar or rank one array with a size of `array_size`, and as the same type of `lambda`. +The result is a scalar or rank one array with a size of `array_size`, and has the same type of `lambda`. ### Example @@ -117,7 +117,7 @@ All arguments must have the same type. ### Return value -The result is a scalar or an array, with a shape conformable to arguments, and as the same type of input arguments. +The result is a scalar or an array, with a shape conformable to arguments, and has the same type of input arguments. ### Example @@ -199,7 +199,7 @@ All arguments must have the same type. ### Return value -The result is a scalar or an array, with a shape conformable to arguments, and as the same type of input arguments. +The result is a scalar or an array, with a shape conformable to arguments, and has the same type of input arguments. ### Example