diff --git a/doc/specs/stdlib_stats_distribution_exponential.md b/doc/specs/stdlib_stats_distribution_exponential.md index b11ca6a6c..3c6577697 100644 --- a/doc/specs/stdlib_stats_distribution_exponential.md +++ b/doc/specs/stdlib_stats_distribution_exponential.md @@ -15,20 +15,29 @@ Experimental ### Description 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 (\(\lambda\)), also called the rate of events. +The inverse `scale` parameter `lambda` specifies the average time between events (\(\lambda\)), also called the rate of events. The location `loc` specifies the value by which the distribution is shifted. -Without argument, the function returns a random sample from the standard exponential distribution \(E(\lambda=1)\). +Without argument, the function returns a random sample from the unshifted standard exponential distribution \(E(\lambda=1)\) or \(E(loc=0, scale=1)\). -With a single argument, the function returns a random sample from the exponential distribution \(E(\lambda=\text{lambda})\). +With a single argument of type `real`, the function returns a random sample from the exponential distribution \(E(\lambda=\text{lambda})\). For complex arguments, the real and imaginary parts are sampled independently of each other. -With two arguments, the function returns a rank-1 array of exponentially distributed random variates. +With one argument of type `real` and one argument of type `integer`, the function returns a rank-1 array of exponentially distributed random variates for (E(\lambda=\text{lambda})\). + +With two arguments of type `real`, the function returns a random sample from the exponential distribution \(E(loc=loc, scale=scale)\). +For complex arguments, the real and imaginary parts are sampled independently of each other. + +With two arguments of type `real` and one argument of type `integer`, the function returns a rank-1 array of exponentially distributed random variates for \(E(loc=loc, scale=scale)\). @note The algorithm used for generating exponential random variates is fundamentally limited to double precision.[^1] ### Syntax +`result = ` [[stdlib_stats_distribution_exponential(module):rvs_exp(interface)]] `([loc, scale] [[, array_size]])` + +or + `result = ` [[stdlib_stats_distribution_exponential(module):rvs_exp(interface)]] `([lambda] [[, array_size]])` ### Class @@ -40,13 +49,21 @@ Elemental function `lambda`: optional argument has `intent(in)` and is a scalar of type `real` or `complex`. If `lambda` is `real`, its value must be positive. If `lambda` is `complex`, both the real and imaginary components must be positive. +`loc`: optional argument has `intent(in)` and is a scalar of type `real` or `complex`. + +`scale`: optional argument has `intent(in)` and is a positive scalar of type `real` or `complex`. +If `scale` is `real`, its value must be positive. If `scale` is `complex`, both the real and imaginary components must be positive. + `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-1 array with a size of `array_size`, and the same type as `lambda`. +If `lambda` is passed, the result is a scalar or rank-1 array with a size of `array_size`, and the same type as `lambda`. If `lambda` is non-positive, the result is `NaN`. +If `loc` and `scale` are passed, the result is a scalar or rank-1 array with a size of `array_size`, and the same type as `scale`. +If `scale` is non-positive, the result is `NaN`. + ### Example ```fortran @@ -69,8 +86,14 @@ For a complex variable \(z=(x + y i)\) with independent real \(x\) and imaginary $$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 &\text{otherwise}\end{cases}$$ +Instead of of the inverse scale parameter `lambda`, it is possible to pass `loc` and `scale`, where \(scale = \frac{1}{\lambda}\) and `loc` specifies the value by which the distribution is shifted. + ### Syntax +`result = ` [[stdlib_stats_distribution_exponential(module):pdf_exp(interface)]] `(x, loc, scale)` + +or + `result = ` [[stdlib_stats_distribution_exponential(module):pdf_exp(interface)]] `(x, lambda)` ### Class @@ -84,11 +107,17 @@ Elemental function `lambda`: has `intent(in)` and is a scalar of type `real` or `complex`. If `lambda` is `real`, its value must be positive. If `lambda` is `complex`, both the real and imaginary components must be positive. +`loc`: has `intent(in)` and is a scalar of type `real` or `complex`. + +`scale`: has `intent(in)` and is a positive scalar of type `real` or `complex`. +If `scale` is `real`, its value must be positive. If `scale` is `complex`, both the real and imaginary components must be positive. + All arguments must have the same type. ### Return value -The result is a scalar or an array, with a shape conformable to the arguments, and the same type as the input arguments. If `lambda` is non-positive, the result is `NaN`. +The result is a scalar or an array, with a shape conformable to the arguments, and the same type as the input arguments. If non-positive `lambda` or `scale`, the result is `NaN`. + ### Example @@ -112,8 +141,14 @@ For a complex variable \(z=(x + y i)\) with independent real \(x\) and imaginar $$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 & \text{otherwise} \end{cases}$$ +Alternative to the inverse scale parameter `lambda`, it is possible to pass `loc` and `scale`, where \(scale = \frac{1}{\lambda}\) and `loc` specifies the value by which the distribution is shifted. + ### Syntax +`result = ` [[stdlib_stats_distribution_exponential(module):cdf_exp(interface)]] `(x, loc, scale)` + +or + `result = ` [[stdlib_stats_distribution_exponential(module):cdf_exp(interface)]] `(x, lambda)` ### Class @@ -127,11 +162,16 @@ Elemental function `lambda`: has `intent(in)` and is a scalar of type `real` or `complex`. If `lambda` is `real`, its value must be positive. If `lambda` is `complex`, both the real and imaginary components must be positive. +`loc`: has `intent(in)` and is a scalar of type `real` or `complex`. + +`scale`: has `intent(in)` and is a positive scalar of type `real` or `complex`. +If `scale` is `real`, its value must be positive. If `scale` is `complex`, both the real and imaginary components must be positive. + All arguments must have the same type. ### Return value -The result is a scalar or an array, with a shape conformable to the arguments, and the same type as the input arguments. If `lambda` is non-positive, the result is `NaN`. +The result is a scalar or an array, with a shape conformable to the arguments, and the same type as the input arguments. With non-positive `lambda` or `scale`, the result is `NaN`. ### Example diff --git a/example/stats_distribution_exponential/example_exponential_cdf.f90 b/example/stats_distribution_exponential/example_exponential_cdf.f90 index 9f108a686..5df68d88d 100644 --- a/example/stats_distribution_exponential/example_exponential_cdf.f90 +++ b/example/stats_distribution_exponential/example_exponential_cdf.f90 @@ -4,15 +4,19 @@ program example_exponential_cdf rexp => rvs_exp implicit none - real, dimension(2, 3, 4) :: x, lambda + real, dimension(2, 3, 4) :: x, loc, scale real :: xsum - complex :: scale + complex :: cloc, cscale integer :: seed_put, seed_get, i seed_put = 1234567 call random_seed(seed_put, seed_get) - ! standard exponential cumulative distribution at x=1.0 + ! standard exponential cumulative distribution at x=1.0 with loc=0.0, scale=1.0 + print *, exp_cdf(1.0, 0.0, 1.0) + ! 0.632120550 + + ! standard exponential cumulative distribution at x=1.0 with lambda=1.0 print *, exp_cdf(1.0, 1.0) ! 0.632120550 @@ -20,44 +24,60 @@ program example_exponential_cdf print *, exp_cdf(2.0, 2.0) ! 0.981684387 - ! cumulative distribution at x=2.0 with lambda=-1.0 (out of range) - print *, exp_cdf(2.0, -1.0) + ! cumulative distribution at x=2.0 with loc=0.0 and scale=0.5 (equivalent of lambda=2) + print *, exp_cdf(2.0, 0.0, 0.5) + ! 0.981684387 + + ! cumulative distribution at x=2.5 with loc=0.5 and scale=0.5 (equivalent of lambda=2) + print *, exp_cdf(2.5, 0.5, 0.5) + ! 0.981684387 + + ! cumulative distribution at x=2.0 with loc=0.0 and scale=-1.0 (out of range) + print *, exp_cdf(2.0, 0.0, -1.0) ! NaN + ! cumulative distribution at x=0.5 with loc=1.0 and scale=1.0, putting x below the minimum + print *, exp_cdf(0.5, 1.0, 1.0) + ! 0.00000000 + ! standard exponential random variates array - x = reshape(rexp(0.5, 24), [2, 3, 4]) + x = reshape(rexp(0.0, 2.0, 24), [2, 3, 4]) ! a rank-3 exponential cumulative distribution - lambda(:, :, :) = 0.5 - print *, exp_cdf(x, lambda) + loc(:, :, :) = 0.0 + scale(:, :, :) = 2.0 + print *, exp_cdf(x, loc, scale) ! 0.301409245 0.335173965 5.94930053E-02 0.113003314 ! 0.365694344 0.583515942 0.113774836 0.838585377 ! 0.509324908 0.127967060 0.857194781 0.893231630 ! 0.355383813 0.470882893 0.574203610 0.799321830 ! 0.546216846 0.111995399 0.801794767 0.922525287 - ! 0.937719882 0.301136374 3.44503522E-02 0.134661376 + ! 0.937719882 0.301136374 3.44503522E-02 0.134661376 + - ! cumulative distribution array where lambda<=0.0 for certain elements - print *, exp_cdf([1.0, 1.0, 1.0], [1.0, 0.0, -1.0]) + ! cumulative distribution array where scale<=0.0 for certain elements + print *, exp_cdf([1.0, 1.0, 1.0], [0.0, 0.0, 0.0], [1.0, 0.0, -1.0]) ! 0.632120550 NaN NaN - ! `cdf_exp` is pure and, thus, can be called concurrently + ! `cdf_exp` is pure and, thus, can be called concurrently xsum = 0.0 do concurrent (i=1:size(x,3)) - xsum = xsum + sum(exp_cdf(x(:,:,i), lambda(:,:,i))) + xsum = xsum + sum(exp_cdf(x(:,:,i), loc(:,:,i), scale(:,:,i))) end do print *, xsum ! 11.0886612 - ! complex exponential cumulative distribution at (0.5,0.5) with real part of - ! lambda=0.5 and imaginary part of lambda=1.0 - scale = (0.5, 1.0) - print *, exp_cdf((0.5, 0.5), scale) + ! complex exponential cumulative distribution at (0.5, 0.0, 2) with real part of + ! scale=2 and imaginary part of scale=1.0 + cloc = (0.0, 0.0) + cscale = (2, 1.0) + print *, exp_cdf((0.5, 0.5), cloc, cscale) ! 8.70351046E-02 - ! As above, but with lambda%im < 0 - scale = (1.0, -2.0) - print *, exp_cdf((1.5, 1.0), scale) + ! As above, but with scale%im < 0 + cloc = (0.0, 0.0) + cscale = (1.0, -2.0) + print *, exp_cdf((1.5, 1.0), cloc, cscale) ! NaN end program example_exponential_cdf diff --git a/example/stats_distribution_exponential/example_exponential_pdf.f90 b/example/stats_distribution_exponential/example_exponential_pdf.f90 index 77c534f7f..29760e4e7 100644 --- a/example/stats_distribution_exponential/example_exponential_pdf.f90 +++ b/example/stats_distribution_exponential/example_exponential_pdf.f90 @@ -4,59 +4,74 @@ program example_exponential_pdf rexp => rvs_exp implicit none - real, dimension(2, 3, 4) :: x, lambda + real, dimension(2, 3, 4) :: x, loc, scale real :: xsum - complex :: scale + complex :: cloc, cscale integer :: seed_put, seed_get, i seed_put = 1234567 call random_seed(seed_put, seed_get) - ! probability density at x=1.0 in standard exponential + ! probability density at x=1.0 with loc=0 and scale=1.0 + print *, exp_pdf(1.0, 0.0, 1.0) + ! 0.367879450 + + ! probability density at x=1.0 with lambda=1.0 print *, exp_pdf(1.0, 1.0) ! 0.367879450 ! probability density at x=2.0 with lambda=2.0 - print *, exp_pdf(2.0, 2.0) + print *, exp_pdf(2.0, 2.0) + ! 3.66312787E-02 + + ! probability density at x=2.0 with loc=0.0 and scale=0.5 (lambda=2.0) + print *, exp_pdf(2.0, 0.0, 0.5) + ! 3.66312787E-02 + + ! probability density at x=1.5 with loc=0.5 and scale=0.5 (lambda=2.0) + print *, exp_pdf(2.5, 0.5, 0.5) ! 3.66312787E-02 - ! probability density at x=2.0 with lambda=-1.0 (out of range) - print *, exp_pdf(2.0, -1.0) + ! probability density at x=2.0 with loc=0.0 and scale=-1.0 (out of range) + print *, exp_pdf(2.0, 0.0, -1.0) ! NaN - ! standard exponential random variates array - x = reshape(rexp(0.5, 24), [2, 3, 4]) + ! standard exponential random variates array + x = reshape(rexp(0.0, 2.0, 24), [2, 3, 4]) ! a rank-3 exponential probability density - lambda(:, :, :) = 0.5 - print *, exp_pdf(x, lambda) + loc(:, :, :) = 0.0 + scale(:, :, :) = 2.0 + print *, exp_pdf(x, loc, scale) ! 0.349295378 0.332413018 0.470253497 0.443498343 0.317152828 ! 0.208242029 0.443112582 8.07073265E-02 0.245337561 0.436016470 ! 7.14025944E-02 5.33841923E-02 0.322308093 0.264558554 0.212898195 ! 0.100339092 0.226891592 0.444002301 9.91026312E-02 3.87373678E-02 - ! 3.11400592E-02 0.349431813 0.482774824 0.432669312 + ! 3.11400592E-02 0.349431813 0.482774824 0.432669312 - ! probability density array where lambda<=0.0 for certain elements - print *, exp_pdf([1.0, 1.0, 1.0], [1.0, 0.0, -1.0]) + ! probability density array where scale<=0.0 for certain elements (loc = 0.0) + print *, exp_pdf([1.0, 1.0, 1.0], [0.0, 0.0, 0.0], [1.0, 0.0, -1.0]) ! 0.367879450 NaN NaN - ! `pdf_exp` is pure and, thus, can be called concurrently + ! `pdf_exp` is pure and, thus, can be called concurrently xsum = 0.0 do concurrent (i=1:size(x,3)) - xsum = xsum + sum(exp_pdf(x(:,:,i), lambda(:,:,i))) + xsum = xsum + sum(exp_pdf(x(:,:,i), loc(:,:,i), scale(:,:,i))) end do print *, xsum ! 6.45566940 - ! complex exponential probability density function at (1.5,1.0) with real part - ! of lambda=1.0 and imaginary part of lambda=2.0 - scale = (1.0, 2.) - print *, exp_pdf((1.5, 1.0), scale) + ! complex exponential probability density function at (1.5, 0.0, 1.0) with real part + ! of scale=1.0 and imaginary part of scale=0.5 + cloc = (0.0, 0.0) + cscale = (1.0, 0.5) + print *, exp_pdf((1.5, 1.0), cloc, cscale) ! 6.03947677E-02 - ! As above, but with lambda%re < 0 - scale = (-1.0, 2.) - print *, exp_pdf((1.5, 1.0), scale) + ! As above, but with scale%re < 0 + cloc = (0.0, 0.0) + cscale = (-1.0, 2.0) + print *, exp_pdf((1.5, 1.0), cloc, cscale) ! NaN end program example_exponential_pdf diff --git a/example/stats_distribution_exponential/example_exponential_rvs.f90 b/example/stats_distribution_exponential/example_exponential_rvs.f90 index 551d2fdce..2f6fb04dd 100644 --- a/example/stats_distribution_exponential/example_exponential_rvs.f90 +++ b/example/stats_distribution_exponential/example_exponential_rvs.f90 @@ -3,30 +3,38 @@ program example_exponential_rvs use stdlib_stats_distribution_exponential, only: rexp => rvs_exp implicit none - complex :: scale + complex :: cloc, cscale 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 lambda=2.0 - -! 0.816459715 - - 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 - - scale = (2.0, 0.7) - print *, rexp(scale) -!single complex exponential random variate with real part of lambda=2.0; -!imagainary part of lambda=0.7 - -! (1.41435969,4.081114382E-02) + ! single standard exponential random variate + print *, rexp() + ! 0.358690143 + + ! exponential random variate with loc=0 and scale=0.5 (lambda=2) + print *, rexp(0.0, 0.5) + ! 0.122672431 + + ! exponential random variate with lambda=2 + print *, rexp(2.0) + ! 0.204114929 + + ! exponential random variate with loc=0.6 and scale=0.2 (lambda=5) + print *, rexp(0.6, 0.2) + ! 0.681645989 + + ! an array of 10 variates with loc=0.0 and scale=3.0 (lambda=1/3) + print *, rexp(0.0, 3.0, 10) + ! 1.36567295 2.62772131 0.362352759 5.47133636 2.13591909 + ! 0.410784155 5.83882189 6.71128035 1.31730068 1.90963650 + + ! single complex exponential random variate with real part of scale=0.5 (lambda=2.0); + ! imagainary part of scale=1.6 (lambda=0.625) + cloc = (0.0, 0.0) + cscale = (0.5, 1.6) + print *, rexp(cloc, cscale) + ! (0.426896989,2.56968451) end program example_exponential_rvs diff --git a/src/stdlib_stats_distribution_exponential.fypp b/src/stdlib_stats_distribution_exponential.fypp index 7e3a43ae4..cf4b43ab3 100644 --- a/src/stdlib_stats_distribution_exponential.fypp +++ b/src/stdlib_stats_distribution_exponential.fypp @@ -9,7 +9,7 @@ module stdlib_stats_distribution_exponential implicit none private - integer :: ke(0:255) + integer :: ke(0:255) real(dp) :: we(0:255), fe(0:255) logical :: zig_exp_initialized = .false. @@ -26,14 +26,26 @@ module stdlib_stats_distribution_exponential !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# !! rvs_exp-exponential-distribution-random-variates)) !! - module procedure rvs_exp_0_rsp !0 dummy variable + module procedure rvs_exp_0_rsp !0 dummy variable + + ! new interfaces using loc and scale #:for k1, t1 in RC_KINDS_TYPES - module procedure rvs_exp_${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_exp_array_${t1[0]}$${k1}$ !2 dummy variables + module procedure rvs_exp_array_${t1[0]}$${k1}$ !2 dummy variables + #:endfor + + ! original interfaces using lambda + + #:for k1, t1 in RC_KINDS_TYPES + module procedure rvs_exp_lambda_${t1[0]}$${k1}$ !1 dummy variable + #:endfor + + #:for k1, t1 in RC_KINDS_TYPES + module procedure rvs_exp_array_lambda_${t1[0]}$${k1}$ !2 dummy variables #:endfor end interface rvs_exp @@ -46,9 +58,17 @@ module stdlib_stats_distribution_exponential !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# !! pdf_exp-exponential-distribution-probability-density-function)) !! + ! new interfaces using loc and scale + #:for k1, t1 in RC_KINDS_TYPES module procedure pdf_exp_${t1[0]}$${k1}$ #:endfor + + ! original interfaces using lambda + + #:for k1, t1 in RC_KINDS_TYPES + module procedure pdf_exp_lambda_${t1[0]}$${k1}$ + #:endfor end interface pdf_exp @@ -60,9 +80,17 @@ module stdlib_stats_distribution_exponential !! ([Specification](../page/specs/stdlib_stats_distribution_exponential.html# !! cdf_exp-exponential-distribution-cumulative-distribution-function)) !! + ! new interfaces using loc and scale + #:for k1, t1 in RC_KINDS_TYPES module procedure cdf_exp_${t1[0]}$${k1}$ #:endfor + + ! original interfaces using lambda + + #:for k1, t1 in RC_KINDS_TYPES + module procedure cdf_exp_lambda_${t1[0]}$${k1}$ + #:endfor end interface cdf_exp @@ -114,7 +142,7 @@ contains #:for k1, t1 in REAL_KINDS_TYPES impure function rvs_exp_0_${t1[0]}$${k1}$( ) result(res) ! - ! Standard exponential random variate (lambda=1) + ! Standard exponential random variate (lambda=1; scale=1/lambda=1) ! ${t1}$ :: res, x ${t1}$, parameter :: r = 7.69711747013104972_${k1}$ @@ -153,18 +181,18 @@ contains #:for k1, t1 in REAL_KINDS_TYPES - impure elemental function rvs_exp_${t1[0]}$${k1}$(lambda) result(res) + impure elemental function rvs_exp_${t1[0]}$${k1}$(loc, scale) result(res) ! ! Exponential distributed random variate ! - ${t1}$, intent(in) :: lambda + ${t1}$, intent(in) :: loc, scale ${t1}$ :: res - if (lambda <= 0._${k1}$) then + if (scale <= 0._${k1}$) then res = ieee_value(1._${k1}$, ieee_quiet_nan) else res = rvs_exp_0_${t1[0]}$${k1}$( ) - res = res / lambda + res = res * scale + loc end if end function rvs_exp_${t1[0]}$${k1}$ @@ -174,13 +202,13 @@ contains #:for k1, t1 in CMPLX_KINDS_TYPES - impure elemental function rvs_exp_${t1[0]}$${k1}$(lambda) result(res) - ${t1}$, intent(in) :: lambda + impure elemental function rvs_exp_${t1[0]}$${k1}$(loc, scale) result(res) + ${t1}$, intent(in) :: loc, scale ${t1}$ :: res real(${k1}$) :: tr, ti - tr = rvs_exp_r${k1}$(lambda % re) - ti = rvs_exp_r${k1}$(lambda % im) + tr = rvs_exp_r${k1}$(loc%re, scale%re) + ti = rvs_exp_r${k1}$(loc%im, scale%im) res = cmplx(tr, ti, kind=${k1}$) end function rvs_exp_${t1[0]}$${k1}$ @@ -190,14 +218,14 @@ contains #:for k1, t1 in REAL_KINDS_TYPES - impure function rvs_exp_array_${t1[0]}$${k1}$(lambda, array_size) result(res) - ${t1}$, intent(in) :: lambda + impure function rvs_exp_array_${t1[0]}$${k1}$(loc, scale, array_size) result(res) + ${t1}$, intent(in) :: loc, scale integer, intent(in) :: array_size ${t1}$ :: res(array_size), x, re ${t1}$, parameter :: r = 7.69711747013104972_${k1}$ integer :: jz, iz, i - if (lambda <= 0._${k1}$) then + if (scale <= 0._${k1}$) then res = ieee_value(1._${k1}$, ieee_quiet_nan) return end if @@ -228,7 +256,7 @@ contains end if end do L1 endif - res(i) = re / lambda + res(i) = re * scale + loc end do end function rvs_exp_array_${t1[0]}$${k1}$ @@ -238,16 +266,16 @@ contains #:for k1, t1 in CMPLX_KINDS_TYPES - impure function rvs_exp_array_${t1[0]}$${k1}$(lambda, array_size) result(res) - ${t1}$, intent(in) :: lambda + impure function rvs_exp_array_${t1[0]}$${k1}$(loc, scale, array_size) result(res) + ${t1}$, intent(in) :: loc, scale integer, intent(in) :: array_size ${t1}$ :: res(array_size) integer :: i real(${k1}$) :: tr, ti do i = 1, array_size - tr = rvs_exp_r${k1}$(lambda % re) - ti = rvs_exp_r${k1}$(lambda % im) + tr = rvs_exp_r${k1}$(loc%re, scale%re) + ti = rvs_exp_r${k1}$(loc%im, scale%im) res(i) = cmplx(tr, ti, kind=${k1}$) end do end function rvs_exp_array_${t1[0]}$${k1}$ @@ -258,19 +286,19 @@ contains #:for k1, t1 in REAL_KINDS_TYPES - elemental function pdf_exp_${t1[0]}$${k1}$(x, lambda) result(res) + elemental function pdf_exp_${t1[0]}$${k1}$(x, loc, scale) result(res) ! ! Exponential Distribution Probability Density Function ! - ${t1}$, intent(in) :: x, lambda + ${t1}$, intent(in) :: x, loc, scale real(${k1}$) :: res - if (lambda <= 0._${k1}$) then + if (scale <= 0._${k1}$) then res = ieee_value(1._${k1}$, ieee_quiet_nan) - else if (x < 0._${k1}$) then + else if (x < loc) then res = 0._${k1}$ else - res = exp(- x * lambda) * lambda + res = exp(- (x - loc) / scale) / scale end if end function pdf_exp_${t1[0]}$${k1}$ @@ -280,12 +308,12 @@ contains #:for k1, t1 in CMPLX_KINDS_TYPES - elemental function pdf_exp_${t1[0]}$${k1}$(x, lambda) result(res) - ${t1}$, intent(in) :: x, lambda + elemental function pdf_exp_${t1[0]}$${k1}$(x, loc, scale) result(res) + ${t1}$, intent(in) :: x, loc, scale real(${k1}$) :: res - res = pdf_exp_r${k1}$(x % re, lambda % re) - res = res * pdf_exp_r${k1}$(x % im, lambda % im) + res = pdf_exp_r${k1}$(x%re, loc%re, scale%re) + res = res * pdf_exp_r${k1}$(x%im, loc%im, scale%im) end function pdf_exp_${t1[0]}$${k1}$ #:endfor @@ -294,19 +322,19 @@ contains #:for k1, t1 in REAL_KINDS_TYPES - elemental function cdf_exp_${t1[0]}$${k1}$(x, lambda) result(res) + elemental function cdf_exp_${t1[0]}$${k1}$(x, loc, scale) result(res) ! ! Exponential Distribution Cumulative Distribution Function ! - ${t1}$, intent(in) :: x, lambda + ${t1}$, intent(in) :: x, loc, scale real(${k1}$) :: res - if (lambda <= 0._${k1}$) then + if (scale <= 0._${k1}$) then res = ieee_value(1._${k1}$, ieee_quiet_nan) - else if (x < 0._${k1}$) then + else if (x < loc) then res = 0._${k1}$ else - res = 1.0_${k1}$ - exp(- x * lambda) + res = 1.0_${k1}$ - exp(- (x - loc) / scale) end if end function cdf_exp_${t1[0]}$${k1}$ @@ -316,14 +344,147 @@ contains #:for k1, t1 in CMPLX_KINDS_TYPES - elemental function cdf_exp_${t1[0]}$${k1}$(x, lambda) result(res) - ${t1}$, intent(in) :: x, lambda + elemental function cdf_exp_${t1[0]}$${k1}$(x, loc, scale) result(res) + ${t1}$, intent(in) :: x, loc, scale real(${k1}$) :: res - res = cdf_exp_r${k1}$(x % re, lambda % re) - res = res * cdf_exp_r${k1}$(x % im, lambda % im) + res = cdf_exp_r${k1}$(x%re, loc%re, scale%re) + res = res * cdf_exp_r${k1}$(x%im, loc%im, scale%im) end function cdf_exp_${t1[0]}$${k1}$ #:endfor + + + + ! + ! below: wrapper functions for interfaces using lambda (for backward compatibility) + ! + + + + + #:for k1, t1 in REAL_KINDS_TYPES + impure elemental function rvs_exp_lambda_${t1[0]}$${k1}$(lambda) result(res) + ! + ! Exponential distributed random variate + ! + ${t1}$, intent(in) :: lambda + ${t1}$ :: res + + res = rvs_exp_${t1[0]}$${k1}$(0._${k1}$, 1.0_${k1}$/lambda) + end function rvs_exp_lambda_${t1[0]}$${k1}$ + + #:endfor + + + + + #:for k1, t1 in CMPLX_KINDS_TYPES + impure elemental function rvs_exp_lambda_${t1[0]}$${k1}$(lambda) result(res) + ${t1}$, intent(in) :: lambda + ${t1}$ :: res + real(${k1}$) :: tr, ti + + tr = rvs_exp_r${k1}$(0._${k1}$, 1.0_${k1}$/lambda%re) + ti = rvs_exp_r${k1}$(0._${k1}$, 1.0_${k1}$/lambda%im) + res = cmplx(tr, ti, kind=${k1}$) + end function rvs_exp_lambda_${t1[0]}$${k1}$ + + #:endfor + + + + + #:for k1, t1 in REAL_KINDS_TYPES + impure function rvs_exp_array_lambda_${t1[0]}$${k1}$(lambda, array_size) result(res) + ${t1}$, intent(in) :: lambda + integer, intent(in) :: array_size + ${t1}$ :: res(array_size) + + res = rvs_exp_array_${t1[0]}$${k1}$(0._${k1}$, 1.0_${k1}$/lambda, array_size) + end function rvs_exp_array_lambda_${t1[0]}$${k1}$ + + #:endfor + + + + + #:for k1, t1 in CMPLX_KINDS_TYPES + impure function rvs_exp_array_lambda_${t1[0]}$${k1}$(lambda, array_size) result(res) + ${t1}$, intent(in) :: lambda + integer, intent(in) :: array_size + ${t1}$ :: res(array_size) + integer :: i + real(${k1}$) :: tr, ti + + do i = 1, array_size + tr = rvs_exp_r${k1}$(0._${k1}$, 1.0_${k1}$/lambda%re) + ti = rvs_exp_r${k1}$(0._${k1}$, 1.0_${k1}$/lambda%im) + res(i) = cmplx(tr, ti, kind=${k1}$) + end do + end function rvs_exp_array_lambda_${t1[0]}$${k1}$ + + #:endfor + + + + + #:for k1, t1 in REAL_KINDS_TYPES + elemental function pdf_exp_lambda_${t1[0]}$${k1}$(x, lambda) result(res) + ! + ! Exponential Distribution Probability Density Function + ! + ${t1}$, intent(in) :: x, lambda + real(${k1}$) :: res + + res = pdf_exp_${t1[0]}$${k1}$(x, 0._${k1}$, 1.0_${k1}$/lambda) + end function pdf_exp_lambda_${t1[0]}$${k1}$ + + #:endfor + + + + + #:for k1, t1 in CMPLX_KINDS_TYPES + elemental function pdf_exp_lambda_${t1[0]}$${k1}$(x, lambda) result(res) + ${t1}$, intent(in) :: x, lambda + real(${k1}$) :: res + + res = pdf_exp_r${k1}$(x%re, 0._${k1}$, 1.0_${k1}$/lambda%re) + res = res * pdf_exp_r${k1}$(x%im, 0._${k1}$, 1.0_${k1}$/lambda%im) + end function pdf_exp_lambda_${t1[0]}$${k1}$ + + #:endfor + + + + + #:for k1, t1 in REAL_KINDS_TYPES + elemental function cdf_exp_lambda_${t1[0]}$${k1}$(x, lambda) result(res) + ! + ! Exponential Distribution Cumulative Distribution Function + ! + ${t1}$, intent(in) :: x, lambda + real(${k1}$) :: res + + res = cdf_exp_${t1[0]}$${k1}$(x, 0._${k1}$, 1.0_${k1}$/lambda) + end function cdf_exp_lambda_${t1[0]}$${k1}$ + + #:endfor + + + + + #:for k1, t1 in CMPLX_KINDS_TYPES + elemental function cdf_exp_lambda_${t1[0]}$${k1}$(x, lambda) result(res) + ${t1}$, intent(in) :: x, lambda + real(${k1}$) :: res + + res = cdf_exp_r${k1}$(x%re, 0._${k1}$, 1.0_${k1}$/lambda%re) + res = res * cdf_exp_r${k1}$(x%im, 0._${k1}$, 1.0_${k1}$/lambda%im) + end function cdf_exp_lambda_${t1[0]}$${k1}$ + + #:endfor + end module stdlib_stats_distribution_exponential diff --git a/test/stats/test_distribution_exponential.fypp b/test/stats/test_distribution_exponential.fypp index 01d3f5bb5..832df2c20 100644 --- a/test/stats/test_distribution_exponential.fypp +++ b/test/stats/test_distribution_exponential.fypp @@ -51,6 +51,8 @@ contains print *, "" print *, "Test exponential random generator with chi-squared" + + ! using interface for lambda freq = 0 do i = 1, num j = 1000 * (1 - exp(- expon_rvs(1.0))) @@ -66,13 +68,31 @@ contains write(*,*) "Chi-squared for exponential random generator is : ", chisq call check((chisq < 1143.9), & msg="exponential randomness failed chi-squared test", warn=warn) + + ! using interface for loc and scale + freq = 0 + do i = 1, num + j = 1000 * (1 - exp(- expon_rvs(0.0, 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 + ${t1}$ :: res(10), lambda, loc, scale integer, parameter :: k = 5 integer :: i integer :: seed, get @@ -116,20 +136,35 @@ contains print *, "Test exponential_distribution_rvs_${t1[0]}$${k1}$" seed = 593742186 - call random_seed(seed, get) + ! set args #:if t1[0] == "r" #! for real type - scale = 1.5_${k1}$ + lambda = 1.5_${k1}$ + loc = 0._${k1}$ + scale = 1.0_${k1}$/lambda #:else #! for complex type - scale = (0.7_${k1}$, 1.3_${k1}$) + lambda = (0.7_${k1}$, 1.3_${k1}$) + loc = (0._${k1}$, 0._${k1}$) + scale = cmplx(1.0_${k1}$/lambda%re, 1.0_${k1}$/lambda%im, kind=${k1}$) #:endif + ! tests using interface for lambda + call random_seed(seed, get) + do i = 1, k + res(i) = expon_rvs(lambda) ! 1 dummy + end do + res(6:10) = expon_rvs(lambda, k) ! 2 dummies + call check(all(abs(res - ans) < ${k1}$tol), & + msg="exponential_distribution_rvs_${t1[0]}$${k1}$ failed", warn=warn) + + ! tests using interface for loc and scale + call random_seed(seed, get) do i = 1, k - res(i) = expon_rvs(scale) ! 1 dummy + res(i) = expon_rvs(loc, scale) end do - res(6:10) = expon_rvs(scale, k) ! 2 dummies + res(6:10) = expon_rvs(loc, scale, k) 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}$ @@ -142,7 +177,7 @@ contains #:for k1, t1 in RC_KINDS_TYPES subroutine test_expon_pdf_${t1[0]}$${k1}$ - ${t1}$ :: x1, x2(3,4), scale + ${t1}$ :: x1, x2(3,4), lambda, loc, scale integer :: seed, get real(${k1}$) :: res(3,5) #:if t1[0] == "r" @@ -185,21 +220,38 @@ contains print *, "Test exponential_distribution_pdf_${t1[0]}$${k1}$" seed = 123987654 - call random_seed(seed, get) + + ! set args #:if t1[0] == "r" #! for real type - scale = 1.5_${k1}$ + lambda = 1.5_${k1}$ + loc = 0._${k1}$ + scale = 1.0_${k1}$/lambda #:else #! for complex type - scale = (0.3_${k1}$, 1.6_${k1}$) + lambda = (0.3_${k1}$, 1.6_${k1}$) + loc = (0._${k1}$, 0._${k1}$) + scale = cmplx(1.0_${k1}$/lambda%re, 1.0_${k1}$/lambda%im, kind=${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) + ! tests using interface for lambda + call random_seed(seed, get) + x1 = expon_rvs(lambda) + x2 = reshape(expon_rvs(lambda, 12), [3,4]) + res(:,1) = expon_pdf(x1, lambda) + res(:, 2:5) = expon_pdf(x2, lambda) + call check(all(abs(res - reshape(ans, [3,5])) < ${k1}$tol), & + msg="exponential_distribution_pdf_${t1[0]}$${k1}$ failed", warn=warn) + + ! tests using interface for loc and scale + call random_seed(seed, get) + x1 = expon_rvs(loc, scale) + x2 = reshape(expon_rvs(loc, scale, 12), [3,4]) + res(:,1) = expon_pdf(x1, loc, scale) + res(:, 2:5) = expon_pdf(x2, loc, 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 @@ -210,7 +262,7 @@ contains #:for k1, t1 in RC_KINDS_TYPES subroutine test_expon_cdf_${t1[0]}$${k1}$ - ${t1}$ :: x1, x2(3,4), scale + ${t1}$ :: x1, x2(3,4), lambda, loc, scale integer :: seed, get real(${k1}$) :: res(3,5) #:if t1[0] == "r" @@ -252,21 +304,37 @@ contains print *, "Test exponential_distribution_cdf_${t1[0]}$${k1}$" seed = 621957438 - call random_seed(seed, get) + ! set args #:if t1[0] == "r" #! for real type - scale = 2.0_${k1}$ + lambda = 2.0_${k1}$ + loc = 0._${k1}$ + scale = 1.0_${k1}$/lambda #:else - scale = (1.3_${k1}$, 2.1_${k1}$) + lambda = (1.3_${k1}$, 2.1_${k1}$) + loc = (0._${k1}$, 0._${k1}$) + scale = cmplx(1.0_${k1}$/lambda%re, 1.0_${k1}$/lambda%im, kind=${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) + ! tests using interface for lambda + call random_seed(seed, get) + x1 = expon_rvs(lambda) + x2 = reshape(expon_rvs(lambda, 12), [3,4]) + res(:,1) = expon_cdf(x1, lambda) + res(:, 2:5) = expon_cdf(x2, lambda) + call check(all(abs(res - reshape(ans,[3,5])) < ${k1}$tol), & + msg="exponential_distribution_cdf_${t1[0]}$${k1}$ failed", warn=warn) + + ! tests using interface for loc and scale + call random_seed(seed, get) + x1 = expon_rvs(loc, scale) + x2 = reshape(expon_rvs(loc, scale, 12), [3,4]) + res(:,1) = expon_cdf(x1, loc, scale) + res(:, 2:5) = expon_cdf(x2, loc, 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