Skip to content

Commit 1acee0a

Browse files
zozihazoziha
committed
Fix bug.
1 parent f181750 commit 1acee0a

File tree

5 files changed

+210
-4
lines changed

5 files changed

+210
-4
lines changed

‎Changelog.md

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
# v1.0.2
22

33
- `forlab_stats`
4-
- redirect `mean`, `var` to `stdlib_stats`.
4+
- redirect `mean`, to `stdlib_stats`.
55
- `forlab_io`
66
- add `read_line` and `read_file`.
77
- `forlab_math`

‎meta-src/forlab_stats.fypp

+2-2
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
module forlab_stats
44

55
use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64
6-
use stdlib_stats, only: mean, var
6+
use stdlib_stats, only: mean
77
implicit none
88
private
99

@@ -53,7 +53,7 @@ module forlab_stats
5353
end subroutine rng
5454
end interface
5555

56-
#:set VSNAME = ['std']
56+
#:set VSNAME = ['var', 'std']
5757
#:for v1 in VSNAME
5858
interface ${v1}$
5959
!! `std` computes vector and matrix standard deviations.

‎meta-src/forlab_stats_std.fypp

+65
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
#:include 'common.fypp'
2+
3+
submodule(forlab_stats) forlab_stats_var
4+
5+
implicit none
6+
7+
contains
8+
9+
#:set VSNAME = ['var', 'std']
10+
#:for v1 in VSNAME
11+
#:for k1, t1 in REAL_KINDS_TYPES
12+
module procedure ${v1}$_1_${k1}$
13+
integer :: opt_w
14+
15+
opt_w = 0
16+
if (present(w)) opt_w = w
17+
#:if v1 == 'var'
18+
select case (opt_w)
19+
case (0)
20+
${v1}$_1_${k1}$ = sum((x - mean(x))**2)/(size(x) - 1)
21+
case (1)
22+
${v1}$_1_${k1}$ = sum((x - mean(x))**2)/size(x)
23+
end select
24+
#:elif v1 == 'std'
25+
${v1}$_1_${k1}$ = sqrt(var_1_${k1}$(x, opt_w))
26+
#:endif
27+
return
28+
end procedure ${v1}$_1_${k1}$
29+
30+
module procedure ${v1}$_2_${k1}$
31+
#:if v1 == 'var'
32+
integer :: opt_w, i, m, n
33+
#:elif v1 == 'std'
34+
integer :: opt_w
35+
#:endif
36+
37+
opt_w = 0
38+
if (present(w)) opt_w = w
39+
#:if v1 == 'var'
40+
m = size(A, 1)
41+
n = size(A, 2)
42+
if ((.not. present(dim)) .or. (dim == 1)) then
43+
allocate (${v1}$_2_${k1}$(n))
44+
do i = 1, n
45+
${v1}$_2_${k1}$(i) = ${v1}$_1_${k1}$(A(:, i), opt_w)
46+
end do
47+
elseif (dim == 2) then
48+
allocate (${v1}$_2_${k1}$(m))
49+
do i = 1, m
50+
${v1}$_2_${k1}$(i) = ${v1}$_1_${k1}$(A(i, :), opt_w)
51+
end do
52+
end if
53+
#:elif v1 == 'std'
54+
if (.not. present(dim)) then
55+
std_2_${k1}$ = sqrt(var_2_${k1}$(A, opt_w))
56+
else
57+
std_2_${k1}$ = sqrt(var_2_${k1}$(A, opt_w, dim))
58+
end if
59+
#:endif
60+
return
61+
end procedure ${v1}$_2_${k1}$
62+
#:endfor
63+
#:endfor
64+
65+
end submodule forlab_stats_var

‎src/forlab_stats.f90

+23-1
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
module forlab_stats
33

44
use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64
5-
use stdlib_stats, only: mean, var
5+
use stdlib_stats, only: mean
66
implicit none
77
private
88

@@ -101,6 +101,28 @@ module subroutine rng(seed)
101101
end subroutine rng
102102
end interface
103103

104+
interface var
105+
!! `std` computes vector and matrix standard deviations.
106+
!!([Specification](../module/forlab_var.html))
107+
real(sp) module function var_1_sp(x, w)
108+
real(sp), dimension(:), intent(in) :: x
109+
integer, intent(in), optional :: w
110+
end function var_1_sp
111+
module function var_2_sp(A, w, dim)
112+
real(sp), dimension(:), allocatable :: var_2_sp
113+
real(sp), dimension(:, :), intent(in) :: A
114+
integer, intent(in), optional :: w, dim
115+
end function var_2_sp
116+
real(dp) module function var_1_dp(x, w)
117+
real(dp), dimension(:), intent(in) :: x
118+
integer, intent(in), optional :: w
119+
end function var_1_dp
120+
module function var_2_dp(A, w, dim)
121+
real(dp), dimension(:), allocatable :: var_2_dp
122+
real(dp), dimension(:, :), intent(in) :: A
123+
integer, intent(in), optional :: w, dim
124+
end function var_2_dp
125+
end interface var
104126
interface std
105127
!! `std` computes vector and matrix standard deviations.
106128
!!([Specification](../module/forlab_var.html))

‎src/forlab_stats_std.f90

+119
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,119 @@
1+
2+
submodule(forlab_stats) forlab_stats_var
3+
4+
implicit none
5+
6+
contains
7+
8+
module procedure var_1_sp
9+
integer :: opt_w
10+
11+
opt_w = 0
12+
if (present(w)) opt_w = w
13+
select case (opt_w)
14+
case (0)
15+
var_1_sp = sum((x - mean(x))**2)/(size(x) - 1)
16+
case (1)
17+
var_1_sp = sum((x - mean(x))**2)/size(x)
18+
end select
19+
return
20+
end procedure var_1_sp
21+
22+
module procedure var_2_sp
23+
integer :: opt_w, i, m, n
24+
25+
opt_w = 0
26+
if (present(w)) opt_w = w
27+
m = size(A, 1)
28+
n = size(A, 2)
29+
if ((.not. present(dim)) .or. (dim == 1)) then
30+
allocate (var_2_sp(n))
31+
do i = 1, n
32+
var_2_sp(i) = var_1_sp(A(:, i), opt_w)
33+
end do
34+
elseif (dim == 2) then
35+
allocate (var_2_sp(m))
36+
do i = 1, m
37+
var_2_sp(i) = var_1_sp(A(i, :), opt_w)
38+
end do
39+
end if
40+
return
41+
end procedure var_2_sp
42+
module procedure var_1_dp
43+
integer :: opt_w
44+
45+
opt_w = 0
46+
if (present(w)) opt_w = w
47+
select case (opt_w)
48+
case (0)
49+
var_1_dp = sum((x - mean(x))**2)/(size(x) - 1)
50+
case (1)
51+
var_1_dp = sum((x - mean(x))**2)/size(x)
52+
end select
53+
return
54+
end procedure var_1_dp
55+
56+
module procedure var_2_dp
57+
integer :: opt_w, i, m, n
58+
59+
opt_w = 0
60+
if (present(w)) opt_w = w
61+
m = size(A, 1)
62+
n = size(A, 2)
63+
if ((.not. present(dim)) .or. (dim == 1)) then
64+
allocate (var_2_dp(n))
65+
do i = 1, n
66+
var_2_dp(i) = var_1_dp(A(:, i), opt_w)
67+
end do
68+
elseif (dim == 2) then
69+
allocate (var_2_dp(m))
70+
do i = 1, m
71+
var_2_dp(i) = var_1_dp(A(i, :), opt_w)
72+
end do
73+
end if
74+
return
75+
end procedure var_2_dp
76+
module procedure std_1_sp
77+
integer :: opt_w
78+
79+
opt_w = 0
80+
if (present(w)) opt_w = w
81+
std_1_sp = sqrt(var_1_sp(x, opt_w))
82+
return
83+
end procedure std_1_sp
84+
85+
module procedure std_2_sp
86+
integer :: opt_w
87+
88+
opt_w = 0
89+
if (present(w)) opt_w = w
90+
if (.not. present(dim)) then
91+
std_2_sp = sqrt(var_2_sp(A, opt_w))
92+
else
93+
std_2_sp = sqrt(var_2_sp(A, opt_w, dim))
94+
end if
95+
return
96+
end procedure std_2_sp
97+
module procedure std_1_dp
98+
integer :: opt_w
99+
100+
opt_w = 0
101+
if (present(w)) opt_w = w
102+
std_1_dp = sqrt(var_1_dp(x, opt_w))
103+
return
104+
end procedure std_1_dp
105+
106+
module procedure std_2_dp
107+
integer :: opt_w
108+
109+
opt_w = 0
110+
if (present(w)) opt_w = w
111+
if (.not. present(dim)) then
112+
std_2_dp = sqrt(var_2_dp(A, opt_w))
113+
else
114+
std_2_dp = sqrt(var_2_dp(A, opt_w, dim))
115+
end if
116+
return
117+
end procedure std_2_dp
118+
119+
end submodule forlab_stats_var

0 commit comments

Comments
 (0)