Skip to content

Commit bb852d2

Browse files
author
Juan Fiol
committed
Added macro to create routine names
1 parent 7c30056 commit bb852d2

File tree

4 files changed

+86
-103
lines changed

4 files changed

+86
-103
lines changed

‎src/common.fypp

+15
Original file line numberDiff line numberDiff line change
@@ -97,5 +97,20 @@ ${prefix + joinstr.join([line.strip() for line in txt.split("\n")]) + suffix}$
9797
#:endif
9898
#:enddef
9999

100+
#! Generates a routine name from a generic name, rank, type and kind
101+
#!
102+
#! Args:
103+
#! gname (str): Generic name
104+
#! rank (integer): Rank if exist
105+
#! type (str): Type of the input
106+
#! kind (str): kind of inputs variable
107+
#! suffix (str): other identifier (could be used for output type/kind)
108+
#!
109+
#! Returns:
110+
#! A string with a new name
111+
#!
112+
#:def rname(gname, rank, type, kind, suffix='')
113+
$:"{0}_{1}_{2}{3}_{2}{3}".format(gname, rank, type[0], kind) if suffix == '' else "{0}_{1}_{2}{3}_{4}".format(gname, rank, type[0], kind, suffix)
114+
#:enddef
100115

101116
#:endmute

‎src/stdlib_experimental_stats.fypp

+24-42
Original file line numberDiff line numberDiff line change
@@ -10,113 +10,95 @@ module stdlib_experimental_stats
1010
public :: mean
1111

1212
interface mean
13-
#:def name(Rank, Type, Kind)
14-
$:"mean_{0}_all_{1}{2}_{1}{2}".format(Rank, Type[0], Kind)
15-
#:enddef
1613
#:for k1, t1 in RC_KINDS_TYPES
1714
#:for rank in RANKS
18-
module function ${name(rank, t1, k1)}$ (x, mask) result(res)
15+
#:set RName = rname("mean_all",rank, t1, k1)
16+
module function ${RName}$ (x, mask) result(res)
1917
${t1}$, intent(in) :: x${ranksuffix(rank)}$
2018
logical, intent(in), optional :: mask
2119
${t1}$ :: res
22-
end function ${name(rank, t1, k1)}$
20+
end function ${RName}$
2321
#:endfor
2422
#:endfor
2523

26-
#:def name(Rank, Type, Kind)
27-
$:"mean_{0}_all_{1}{2}_rdp".format(Rank, Type[0], Kind)
28-
#:enddef
2924
#:for k1, t1 in INT_KINDS_TYPES
3025
#:for rank in RANKS
31-
module function ${name(rank, t1, k1)}$ (x, mask) result(res)
26+
#:set RName = rname('mean_all', rank, t1, k1,'dp')
27+
module function ${RName}$(x, mask) result(res)
3228
${t1}$, intent(in) :: x${ranksuffix(rank)}$
3329
logical, intent(in), optional :: mask
3430
real(dp) :: res
35-
end function ${name(rank, t1, k1)}$
31+
end function ${RName}$
3632
#:endfor
3733
#:endfor
3834

39-
#:def name(Rank, Type, Kind)
40-
$:"mean_{0}_{1}{2}_{1}{2}".format(Rank, Type[0], Kind)
41-
#:enddef
4235
#:for k1, t1 in RC_KINDS_TYPES
4336
#:for rank in RANKS
44-
module function ${name(rank, t1, k1)}$(x, dim, mask) result(res)
37+
#:set RName = rname("mean",rank, t1, k1)
38+
module function ${RName}$(x, dim, mask) result(res)
4539
${t1}$, intent(in) :: x${ranksuffix(rank)}$
4640
integer, intent(in) :: dim
4741
logical, intent(in), optional :: mask
4842
${t1}$ :: res${reduced_shape('x', rank, 'dim')}$
49-
end function ${name(rank, t1, k1)}$
43+
end function ${RName}$
5044
#:endfor
5145
#:endfor
5246

53-
#:def name(Rank, Type, Kind)
54-
$:"mean_{0}_{1}{2}_rdp".format(Rank, Type[0], Kind)
55-
#:enddef
5647
#:for k1, t1 in INT_KINDS_TYPES
5748
#:for rank in RANKS
58-
module function ${name(rank, t1, k1)}$(x, dim, mask) result(res)
49+
#:set RName = rname("mean",rank, t1, k1,'dp')
50+
module function ${RName}$(x, dim, mask) result(res)
5951
${t1}$, intent(in) :: x${ranksuffix(rank)}$
6052
integer, intent(in) :: dim
6153
logical, intent(in), optional :: mask
6254
real(dp) :: res${reduced_shape('x', rank, 'dim')}$
63-
end function ${name(rank, t1, k1)}$
55+
end function ${RName}$
6456
#:endfor
6557
#:endfor
6658

67-
#:def name(Rank, Type, Kind)
68-
$:"mean_{0}_mask_all_{1}{2}_{1}{2}".format(Rank, Type[0], Kind)
69-
#:enddef
7059
#:for k1, t1 in RC_KINDS_TYPES
7160
#:for rank in RANKS
72-
module function ${name(rank, t1, k1)}$(x, mask) result(res)
61+
#:set RName = rname('mean_mask_all',rank, t1, k1)
62+
module function ${RName}$(x, mask) result(res)
7363
${t1}$, intent(in) :: x${ranksuffix(rank)}$
7464
logical, intent(in) :: mask${ranksuffix(rank)}$
7565
${t1}$ :: res
76-
end function ${name(rank, t1, k1)}$
77-
66+
end function ${RName}$
7867
#:endfor
7968
#:endfor
8069

81-
#:def name(Rank, Type, Kind)
82-
$:"mean_{0}_mask_all_{1}{2}_rdp".format(Rank, Type[0], Kind)
83-
#:enddef
8470
#:for k1, t1 in INT_KINDS_TYPES
8571
#:for rank in RANKS
86-
module function ${name(rank, t1, k1)}$(x, mask) result(res)
72+
#:set RName = rname('mean_mask_all',rank, t1, k1, 'dp')
73+
module function ${RName}$(x, mask) result(res)
8774
${t1}$, intent(in) :: x${ranksuffix(rank)}$
8875
logical, intent(in) :: mask${ranksuffix(rank)}$
8976
real(dp) :: res
90-
end function ${name(rank, t1, k1)}$
77+
end function ${RName}$
9178
#:endfor
9279
#:endfor
9380

94-
95-
#:def name(Rank, Type, Kind)
96-
$:"mean_{0}_mask_{1}{2}_{1}{2}".format(Rank, Type[0], Kind)
97-
#:enddef
9881
#:for k1, t1 in RC_KINDS_TYPES
9982
#:for rank in RANKS
100-
module function ${name(rank, t1, k1)}$(x, dim, mask) result(res)
83+
#:set RName = rname('mean_mask',rank, t1, k1)
84+
module function ${RName}$(x, dim, mask) result(res)
10185
${t1}$, intent(in) :: x${ranksuffix(rank)}$
10286
integer, intent(in) :: dim
10387
logical, intent(in) :: mask${ranksuffix(rank)}$
10488
${t1}$ :: res${reduced_shape('x', rank, 'dim')}$
105-
end function ${name(rank, t1, k1)}$
89+
end function ${RName}$
10690
#:endfor
10791
#:endfor
10892

109-
#:def name(Rank, Type, Kind)
110-
$:"mean_{0}_mask_{1}{2}_rdp".format(Rank, Type[0], Kind)
111-
#:enddef
11293
#:for k1, t1 in INT_KINDS_TYPES
11394
#:for rank in RANKS
114-
module function ${name(rank, t1, k1)}$(x, dim, mask) result(res)
95+
#:set RName = rname('mean_mask',rank, t1, k1, 'dp')
96+
module function ${RName}$(x, dim, mask) result(res)
11597
${t1}$, intent(in) :: x${ranksuffix(rank)}$
11698
integer, intent(in) :: dim
11799
logical, intent(in) :: mask${ranksuffix(rank)}$
118100
real(dp) :: res${reduced_shape('x', rank, 'dim')}$
119-
end function ${name(rank, t1, k1)}$
101+
end function ${RName}$
120102
#:endfor
121103
#:endfor
122104

‎src/stdlib_experimental_stats_mean.fypp

+24-40
Original file line numberDiff line numberDiff line change
@@ -10,12 +10,10 @@ submodule (stdlib_experimental_stats) stdlib_experimental_stats_mean
1010

1111
contains
1212

13-
#:def name(Rank, Type, Kind)
14-
$:"mean_{0}_all_{1}{2}_{1}{2}".format(Rank, Type[0], Kind)
15-
#:enddef
1613
#:for k1, t1 in RC_KINDS_TYPES
1714
#:for rank in RANKS
18-
module function ${name(rank, t1, k1)}$ (x, mask) result(res)
15+
#:set RName = rname("mean_all",rank, t1, k1)
16+
module function ${RName}$ (x, mask) result(res)
1917
${t1}$, intent(in) :: x${ranksuffix(rank)}$
2018
logical, intent(in), optional :: mask
2119
${t1}$ :: res
@@ -27,16 +25,14 @@ $:"mean_{0}_all_{1}{2}_{1}{2}".format(Rank, Type[0], Kind)
2725

2826
res = sum(x) / real(size(x, kind = int64), ${k1}$)
2927

30-
end function ${name(rank, t1, k1)}$
28+
end function ${RName}$
3129
#:endfor
3230
#:endfor
3331

34-
#:def name(Rank, Type, Kind)
35-
$:"mean_{0}_all_{1}{2}_rdp".format(Rank, Type[0], Kind)
36-
#:enddef
3732
#:for k1, t1 in INT_KINDS_TYPES
3833
#:for rank in RANKS
39-
module function ${name(rank, t1, k1)}$(x, mask) result(res)
34+
#:set RName = rname('mean_all', rank, t1, k1,'dp')
35+
module function ${RName}$(x, mask) result(res)
4036
${t1}$, intent(in) :: x${ranksuffix(rank)}$
4137
logical, intent(in), optional :: mask
4238
real(dp) :: res
@@ -48,17 +44,15 @@ $:"mean_{0}_all_{1}{2}_rdp".format(Rank, Type[0], Kind)
4844

4945
res = sum(real(x, dp)) / real(size(x, kind = int64), dp)
5046

51-
end function ${name(rank, t1, k1)}$
47+
end function ${RName}$
5248
#:endfor
5349
#:endfor
5450

5551

56-
#:def name(Rank, Type, Kind)
57-
$:"mean_{0}_{1}{2}_{1}{2}".format(Rank, Type[0], Kind)
58-
#:enddef
5952
#:for k1, t1 in RC_KINDS_TYPES
6053
#:for rank in RANKS
61-
module function ${name(rank, t1, k1)}$(x, dim, mask) result(res)
54+
#:set RName = rname("mean",rank, t1, k1)
55+
module function ${RName}$(x, dim, mask) result(res)
6256
${t1}$, intent(in) :: x${ranksuffix(rank)}$
6357
integer, intent(in) :: dim
6458
logical, intent(in), optional :: mask
@@ -75,17 +69,15 @@ $:"mean_{0}_{1}{2}_{1}{2}".format(Rank, Type[0], Kind)
7569
call error_stop("ERROR (mean): wrong dimension")
7670
end if
7771

78-
end function ${name(rank, t1, k1)}$
72+
end function ${RName}$
7973
#:endfor
8074
#:endfor
8175

8276

83-
#:def name(Rank, Type, Kind)
84-
$:"mean_{0}_{1}{2}_rdp".format(Rank, Type[0], Kind)
85-
#:enddef
8677
#:for k1, t1 in INT_KINDS_TYPES
8778
#:for rank in RANKS
88-
module function ${name(rank, t1, k1)}$(x, dim, mask) result(res)
79+
#:set RName = rname("mean",rank, t1, k1,'dp')
80+
module function ${RName}$(x, dim, mask) result(res)
8981
${t1}$, intent(in) :: x${ranksuffix(rank)}$
9082
integer, intent(in) :: dim
9183
logical, intent(in), optional :: mask
@@ -102,49 +94,43 @@ $:"mean_{0}_{1}{2}_rdp".format(Rank, Type[0], Kind)
10294
call error_stop("ERROR (mean): wrong dimension")
10395
end if
10496

105-
end function ${name(rank, t1, k1)}$
97+
end function ${RName}$
10698
#:endfor
10799
#:endfor
108100

109-
#:def name(Rank, Type, Kind)
110-
$:"mean_{0}_mask_all_{1}{2}_{1}{2}".format(Rank, Type[0], Kind)
111-
#:enddef
112101
#:for k1, t1 in RC_KINDS_TYPES
113102
#:for rank in RANKS
114-
module function ${name(rank, t1, k1)}$(x, mask) result(res)
103+
#:set RName = rname('mean_mask_all',rank, t1, k1)
104+
module function ${RName}$(x, mask) result(res)
115105
${t1}$, intent(in) :: x${ranksuffix(rank)}$
116106
logical, intent(in) :: mask${ranksuffix(rank)}$
117107
${t1}$ :: res
118108

119109
res = sum(x, mask) / real(count(mask, kind = int64), ${k1}$)
120110

121-
end function ${name(rank, t1, k1)}$
111+
end function ${RName}$
122112
#:endfor
123113
#:endfor
124114

125115

126-
#:def name(Rank, Type, Kind)
127-
$:"mean_{0}_mask_all_{1}{2}_rdp".format(Rank, Type[0], Kind)
128-
#:enddef
129116
#:for k1, t1 in INT_KINDS_TYPES
130117
#:for rank in RANKS
131-
module function ${name(rank, t1, k1)}$(x, mask) result(res)
118+
#:set RName = rname('mean_mask_all',rank, t1, k1, 'dp')
119+
module function ${RName}$(x, mask) result(res)
132120
${t1}$, intent(in) :: x${ranksuffix(rank)}$
133121
logical, intent(in) :: mask${ranksuffix(rank)}$
134122
real(dp) :: res
135123

136124
res = sum(real(x, dp), mask) / real(count(mask, kind = int64), dp)
137125

138-
end function ${name(rank, t1, k1)}$
126+
end function ${RName}$
139127
#:endfor
140128
#:endfor
141129

142-
#:def name(Rank, Type, Kind)
143-
$:"mean_{0}_mask_{1}{2}_{1}{2}".format(Rank, Type[0], Kind)
144-
#:enddef
145130
#:for k1, t1 in RC_KINDS_TYPES
146131
#:for rank in RANKS
147-
module function ${name(rank, t1, k1)}$(x, dim, mask) result(res)
132+
#:set RName = rname('mean_mask',rank, t1, k1)
133+
module function ${RName}$(x, dim, mask) result(res)
148134
${t1}$, intent(in) :: x${ranksuffix(rank)}$
149135
integer, intent(in) :: dim
150136
logical, intent(in) :: mask${ranksuffix(rank)}$
@@ -156,17 +142,15 @@ $:"mean_{0}_mask_{1}{2}_{1}{2}".format(Rank, Type[0], Kind)
156142
call error_stop("ERROR (mean): wrong dimension")
157143
end if
158144

159-
end function ${name(rank, t1, k1)}$
145+
end function ${RName}$
160146
#:endfor
161147
#:endfor
162148

163149

164-
#:def name(Rank, Type, Kind)
165-
$:"mean_{0}_mask_{1}{2}_rdp".format(Rank, Type[0], Kind)
166-
#:enddef
167150
#:for k1, t1 in INT_KINDS_TYPES
168151
#:for rank in RANKS
169-
module function ${name(rank, t1, k1)}$(x, dim, mask) result(res)
152+
#:set RName = rname('mean_mask',rank, t1, k1, 'dp')
153+
module function ${RName}$(x, dim, mask) result(res)
170154
${t1}$, intent(in) :: x${ranksuffix(rank)}$
171155
integer, intent(in) :: dim
172156
logical, intent(in) :: mask${ranksuffix(rank)}$
@@ -178,7 +162,7 @@ $:"mean_{0}_mask_{1}{2}_rdp".format(Rank, Type[0], Kind)
178162
call error_stop("ERROR (mean): wrong dimension")
179163
end if
180164

181-
end function ${name(rank, t1, k1)}$
165+
end function ${RName}$
182166
#:endfor
183167
#:endfor
184168

‎src/tests/stats/test_mean_f03.f90

+23-21
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@ program test_mean
55
use stdlib_experimental_stats, only: mean
66
implicit none
77

8+
real(dp), parameter :: dptol = 2.2e-15_dp
9+
810
real(dp), allocatable :: d(:, :)
911
real(dp), allocatable :: d8(:, :, :, :, :, :, :, :)
1012
complex(dp), allocatable :: cd8(:, :, :, :, :, :, :, :)
@@ -13,41 +15,41 @@ program test_mean
1315
!dp
1416
call loadtxt("array3.dat", d)
1517

16-
call assert( mean(d) - sum(d)/real(size(d), dp) == 0.0_dp)
17-
call assert( sum( abs( mean(d,1) - sum(d,1)/real(size(d,1), dp) )) == 0.0_dp)
18-
call assert( sum( abs( mean(d,2) - sum(d,2)/real(size(d,2), dp) )) == 0.0_dp)
18+
call assert( mean(d) - sum(d)/real(size(d), dp) < dptol)
19+
call assert( sum( abs( mean(d,1) - sum(d,1)/real(size(d,1), dp) )) < dptol)
20+
call assert( sum( abs( mean(d,2) - sum(d,2)/real(size(d,2), dp) )) < dptol)
1921

2022
!dp rank 8
2123
allocate(d8(size(d,1), size(d,2), 3, 4, 5, 6, 7, 8))
2224
d8(:, :, 1, 4, 5 ,6 ,7 ,8)=d;
2325
d8(:, :, 2, 4, 5 ,6 ,7 ,8)=d * 1.5_dp;
2426
d8(:, :, 3, 4, 5 ,6 ,7 ,8)=d * 4._dp;
2527

26-
call assert( mean(d8) - sum(d8)/real(size(d8), dp) == 0.0_dp)
28+
call assert( mean(d8) - sum(d8)/real(size(d8), dp) < dptol)
2729

28-
call assert( sum( abs( mean(d8,1) - sum(d8,1)/real(size(d8,1), dp) )) == 0.0_dp)
29-
call assert( sum( abs( mean(d8,2) - sum(d8,2)/real(size(d8,2), dp) )) == 0.0_dp)
30-
call assert( sum( abs( mean(d8,3) - sum(d8,3)/real(size(d8,3), dp) )) == 0.0_dp)
31-
call assert( sum( abs( mean(d8,4) - sum(d8,4)/real(size(d8,4), dp) )) == 0.0_dp)
32-
call assert( sum( abs( mean(d8,5) - sum(d8,5)/real(size(d8,5), dp) )) == 0.0_dp)
33-
call assert( sum( abs( mean(d8,6) - sum(d8,6)/real(size(d8,6), dp) )) == 0.0_dp)
34-
call assert( sum( abs( mean(d8,7) - sum(d8,7)/real(size(d8,7), dp) )) == 0.0_dp)
35-
call assert( sum( abs( mean(d8,8) - sum(d8,8)/real(size(d8,8), dp) )) == 0.0_dp)
30+
call assert( sum( abs( mean(d8,1) - sum(d8,1)/real(size(d8,1), dp) )) < dptol)
31+
call assert( sum( abs( mean(d8,2) - sum(d8,2)/real(size(d8,2), dp) )) < dptol)
32+
call assert( sum( abs( mean(d8,3) - sum(d8,3)/real(size(d8,3), dp) )) < dptol)
33+
call assert( sum( abs( mean(d8,4) - sum(d8,4)/real(size(d8,4), dp) )) < dptol)
34+
call assert( sum( abs( mean(d8,5) - sum(d8,5)/real(size(d8,5), dp) )) < dptol)
35+
call assert( sum( abs( mean(d8,6) - sum(d8,6)/real(size(d8,6), dp) )) < dptol)
36+
call assert( sum( abs( mean(d8,7) - sum(d8,7)/real(size(d8,7), dp) )) < dptol)
37+
call assert( sum( abs( mean(d8,8) - sum(d8,8)/real(size(d8,8), dp) )) < dptol)
3638

3739
!cdp rank 8
3840
allocate(cd8(size(d,1), size(d,2), 3, 4, 5, 6, 7, 8))
3941
cd8 = cmplx(1._dp, 1._dp, kind=dp)*d8
4042

41-
call assert( mean(cd8) - sum(cd8)/real(size(cd8), dp) == 0.0_dp)
43+
call assert( abs(mean(cd8) - sum(cd8)/real(size(cd8), dp)) < dptol)
4244

43-
call assert( sum( abs( mean(cd8,1) - sum(cd8,1)/real(size(cd8,1), dp) )) == 0.0_dp)
44-
call assert( sum( abs( mean(cd8,2) - sum(cd8,2)/real(size(cd8,2), dp) )) == 0.0_dp)
45-
call assert( sum( abs( mean(cd8,3) - sum(cd8,3)/real(size(cd8,3), dp) )) == 0.0_dp)
46-
call assert( sum( abs( mean(cd8,4) - sum(cd8,4)/real(size(cd8,4), dp) )) == 0.0_dp)
47-
call assert( sum( abs( mean(cd8,5) - sum(cd8,5)/real(size(cd8,5), dp) )) == 0.0_dp)
48-
call assert( sum( abs( mean(cd8,6) - sum(cd8,6)/real(size(cd8,6), dp) )) == 0.0_dp)
49-
call assert( sum( abs( mean(cd8,7) - sum(cd8,7)/real(size(cd8,7), dp) )) == 0.0_dp)
50-
call assert( sum( abs( mean(cd8,8) - sum(cd8,8)/real(size(cd8,8), dp) )) == 0.0_dp)
45+
call assert( sum( abs( mean(cd8,1) - sum(cd8,1)/real(size(cd8,1), dp) )) < dptol)
46+
call assert( sum( abs( mean(cd8,2) - sum(cd8,2)/real(size(cd8,2), dp) )) < dptol)
47+
call assert( sum( abs( mean(cd8,3) - sum(cd8,3)/real(size(cd8,3), dp) )) < dptol)
48+
call assert( sum( abs( mean(cd8,4) - sum(cd8,4)/real(size(cd8,4), dp) )) < dptol)
49+
call assert( sum( abs( mean(cd8,5) - sum(cd8,5)/real(size(cd8,5), dp) )) < dptol)
50+
call assert( sum( abs( mean(cd8,6) - sum(cd8,6)/real(size(cd8,6), dp) )) < dptol)
51+
call assert( sum( abs( mean(cd8,7) - sum(cd8,7)/real(size(cd8,7), dp) )) < dptol)
52+
call assert( sum( abs( mean(cd8,8) - sum(cd8,8)/real(size(cd8,8), dp) )) < dptol)
5153
contains
5254

5355
end program

0 commit comments

Comments
 (0)