Skip to content

modified stats exponential distribution procedures to use loc and scale #991

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 7 commits into from
May 22, 2025
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
54 changes: 47 additions & 7 deletions doc/specs/stdlib_stats_distribution_exponential.md
Original file line number Diff line number Diff line change
@@ -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

60 changes: 40 additions & 20 deletions example/stats_distribution_exponential/example_exponential_cdf.f90
Original file line number Diff line number Diff line change
@@ -4,60 +4,80 @@ 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

! cumulative distribution at x=2.0 with lambda=2
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
59 changes: 37 additions & 22 deletions example/stats_distribution_exponential/example_exponential_pdf.f90
Original file line number Diff line number Diff line change
@@ -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
48 changes: 28 additions & 20 deletions example/stats_distribution_exponential/example_exponential_rvs.f90
Original file line number Diff line number Diff line change
@@ -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
239 changes: 200 additions & 39 deletions src/stdlib_stats_distribution_exponential.fypp
Original file line number Diff line number Diff line change
@@ -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
112 changes: 90 additions & 22 deletions test/stats/test_distribution_exponential.fypp
Original file line number Diff line number Diff line change
@@ -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