Skip to content

Commit ecfbfb0

Browse files
certikcertik
authored
Merge pull request #130 from aradi/mean-1d
Mean 1d
2 parents 11002bd + 75cea6c commit ecfbfb0

4 files changed

+106
-209
lines changed

‎src/common.fypp

+45-1
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@
3737
#! Generates an array rank suffix.
3838
#!
3939
#! Args:
40-
#! rank [in]: Integer with rank.
40+
#! rank (int): Rank of the variable
4141
#!
4242
#! Returns:
4343
#! Array rank suffix string (e.g. (:,:) if rank = 2)
@@ -46,4 +46,48 @@
4646
#{if rank > 0}#(${":" + ",:" * (rank - 1)}$)#{endif}#
4747
#:enddef
4848

49+
50+
#! Joins stripped lines with given character string
51+
#!
52+
#! Args:
53+
#! txt (str): Text to process
54+
#! joinstr (str): String to use as connector
55+
#! prefix (str): String to add as prefix before the joined text
56+
#! suffix (str): String to add as suffix after the joined text
57+
#!
58+
#! Returns:
59+
#! Lines stripped and joined with the given string.
60+
#!
61+
#:def join_lines(txt, joinstr, prefix="", suffix="")
62+
${prefix + joinstr.join([line.strip() for line in txt.split("\n")]) + suffix}$
63+
#:enddef
64+
65+
66+
#! Brace enclosed, comma separated Fortran expressions for a reduced shape.
67+
#!
68+
#! Rank of the original variable will be reduced by one. The routine generates
69+
#! for each dimension a Fortan expression using merge(), which calculates the
70+
#! size of the array for that dimension.
71+
#!
72+
#! Args:
73+
#! varname (str): Name of the variable to be used as origin
74+
#! origrank (int): Rank of the original variable
75+
#! idim (int): Index of the reduced dimension
76+
#!
77+
#! Returns:
78+
#! Shape expression enclosed in braces, so that it can be used as suffix to
79+
#! define array shapes in declarations.
80+
#!
81+
#:def reduced_shape(varname, origrank, idim)
82+
#:assert origrank > 0
83+
#:if origrank > 1
84+
#:call join_lines(joinstr=", ", prefix="(", suffix=")")
85+
#:for i in range(1, origrank)
86+
merge(size(${varname}$, ${i}$), size(${varname}$, ${i + 1}$), mask=${i}$<${idim}$)
87+
#:endfor
88+
#:endcall
89+
#:endif
90+
#:enddef
91+
92+
4993
#:endmute

‎src/stdlib_experimental_stats.fypp

+15-69
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
#:include "common.fypp"
22

3-
#:set RANKS = range(3, MAXRANK + 1)
3+
#:set RANKS = range(1, MAXRANK + 1)
44

55

66
module stdlib_experimental_stats
@@ -12,49 +12,6 @@ module stdlib_experimental_stats
1212
public :: mean
1313

1414
interface mean
15-
#:for k1, t1 in REAL_KINDS_TYPES
16-
module function mean_1_${k1}$_${k1}$(x) result(res)
17-
${t1}$, intent(in) :: x(:)
18-
${t1}$ :: res
19-
end function mean_1_${k1}$_${k1}$
20-
#:endfor
21-
22-
#:for k1, t1 in INT_KINDS_TYPES
23-
module function mean_1_${k1}$_dp(x) result(res)
24-
${t1}$, intent(in) :: x(:)
25-
real(dp) :: res
26-
end function mean_1_${k1}$_dp
27-
#:endfor
28-
29-
#:for k1, t1 in REAL_KINDS_TYPES
30-
module function mean_2_all_${k1}$_${k1}$(x) result(res)
31-
${t1}$, intent(in) :: x(:,:)
32-
${t1}$ :: res
33-
end function mean_2_all_${k1}$_${k1}$
34-
#:endfor
35-
36-
#:for k1, t1 in INT_KINDS_TYPES
37-
module function mean_2_all_${k1}$_dp(x) result(res)
38-
${t1}$, intent(in) :: x(:,:)
39-
real(dp) :: res
40-
end function mean_2_all_${k1}$_dp
41-
#:endfor
42-
43-
#:for k1, t1 in REAL_KINDS_TYPES
44-
module function mean_2_${k1}$_${k1}$(x, dim) result(res)
45-
${t1}$, intent(in) :: x(:,:)
46-
integer, intent(in) :: dim
47-
${t1}$ :: res(merge(size(x, 1), size(x, 2), mask = 1 < dim ))
48-
end function mean_2_${k1}$_${k1}$
49-
#:endfor
50-
51-
#:for k1, t1 in INT_KINDS_TYPES
52-
module function mean_2_${k1}$_dp(x, dim) result(res)
53-
${t1}$, intent(in) :: x(:,:)
54-
integer, intent(in) :: dim
55-
real(dp) :: res(merge(size(x, 1), size(x, 2), mask = 1 < dim ))
56-
end function mean_2_${k1}$_dp
57-
#:endfor
5815

5916
#:for k1, t1 in REAL_KINDS_TYPES
6017
#:for rank in RANKS
@@ -76,34 +33,23 @@ module stdlib_experimental_stats
7633

7734
#:for k1, t1 in REAL_KINDS_TYPES
7835
#:for rank in RANKS
79-
module function mean_${rank}$_${k1}$_${k1}$(x, dim) result(res)
80-
${t1}$, intent(in) :: x${ranksuffix(rank)}$
81-
integer, intent(in) :: dim
82-
${t1}$ :: res( &
83-
#:for imerge in range(1,rank-1)
84-
& merge(size(x, ${imerge}$),size(x, ${imerge + 1}$),&
85-
& mask = ${imerge}$ < dim), &
86-
#:endfor
87-
& merge(size(x, ${rank-1}$), size(x, ${rank}$),&
88-
& mask = ${rank-1}$ < dim))
89-
end function mean_${rank}$_${k1}$_${k1}$
36+
module function mean_${rank}$_${k1}$_${k1}$(x, dim) result(res)
37+
${t1}$, intent(in) :: x${ranksuffix(rank)}$
38+
integer, intent(in) :: dim
39+
${t1}$ :: res${reduced_shape('x', rank, 'dim')}$
40+
end function mean_${rank}$_${k1}$_${k1}$
41+
#:endfor
9042
#:endfor
91-
#:endfor
9243

93-
#:for k1, t1 in INT_KINDS_TYPES
94-
#:for rank in RANKS
95-
module function mean_${rank}$_${k1}$_dp(x, dim) result(res)
96-
${t1}$, intent(in) :: x${ranksuffix(rank)}$
97-
integer, intent(in) :: dim
98-
real(dp) :: res( &
99-
#:for imerge in range(1,rank-1)
100-
& merge(size(x, ${imerge}$), size(x,${imerge + 1}$),&
101-
& mask = ${imerge}$ < dim), &
102-
#:endfor
103-
& merge(size(x,${rank-1}$),size(x,${rank}$),mask = ${rank-1}$ < dim ))
104-
end function mean_${rank}$_${k1}$_dp
44+
#:for k1, t1 in INT_KINDS_TYPES
45+
#:for rank in RANKS
46+
module function mean_${rank}$_${k1}$_dp(x, dim) result(res)
47+
${t1}$, intent(in) :: x${ranksuffix(rank)}$
48+
integer, intent(in) :: dim
49+
real(dp) :: res${reduced_shape('x', rank, 'dim')}$
50+
end function mean_${rank}$_${k1}$_dp
51+
#:endfor
10552
#:endfor
106-
#:endfor
10753

10854
end interface mean
10955

‎src/stdlib_experimental_stats_mean.fypp

+16-116
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
#:include "common.fypp"
22

3-
#:set RANKS = range(3, MAXRANK + 1)
3+
#:set RANKS = range(1, MAXRANK + 1)
44

55

66
submodule (stdlib_experimental_stats) stdlib_experimental_stats_mean
@@ -10,88 +10,6 @@ submodule (stdlib_experimental_stats) stdlib_experimental_stats_mean
1010

1111
contains
1212

13-
#:for k1, t1 in REAL_KINDS_TYPES
14-
module function mean_1_${k1}$_${k1}$(x) result(res)
15-
${t1}$, intent(in) :: x(:)
16-
${t1}$ :: res
17-
18-
res = sum(x) / real(size(x, kind = int64), ${k1}$)
19-
20-
end function mean_1_${k1}$_${k1}$
21-
#:endfor
22-
23-
24-
#:for k1, t1 in INT_KINDS_TYPES
25-
module function mean_1_${k1}$_dp(x) result(res)
26-
${t1}$, intent(in) :: x(:)
27-
real(dp) :: res
28-
29-
res = sum(real(x, dp)) / real(size(x, kind = int64), dp)
30-
31-
end function mean_1_${k1}$_dp
32-
#:endfor
33-
34-
35-
#:for k1, t1 in REAL_KINDS_TYPES
36-
module function mean_2_all_${k1}$_${k1}$(x) result(res)
37-
${t1}$, intent(in) :: x(:,:)
38-
${t1}$ :: res
39-
40-
res = sum(x) / real(size(x, kind = int64), ${k1}$)
41-
42-
end function mean_2_all_${k1}$_${k1}$
43-
#:endfor
44-
45-
46-
#:for k1, t1 in INT_KINDS_TYPES
47-
module function mean_2_all_${k1}$_dp(x) result(res)
48-
${t1}$, intent(in) :: x(:,:)
49-
real(dp) :: res
50-
51-
res = sum(real(x, dp)) / real(size(x, kind = int64), dp)
52-
53-
end function mean_2_all_${k1}$_dp
54-
#:endfor
55-
56-
57-
#:for k1, t1 in REAL_KINDS_TYPES
58-
module function mean_2_${k1}$_${k1}$(x, dim) result(res)
59-
${t1}$, intent(in) :: x(:,:)
60-
integer, intent(in) :: dim
61-
${t1}$ :: res(merge(size(x, 1), size(x, 2), mask = 1 < dim ))
62-
63-
select case(dim)
64-
case(1)
65-
res = sum(x, 1) / real(size(x, 1), ${k1}$)
66-
case(2)
67-
res = sum(x, 2) / real(size(x, 2), ${k1}$)
68-
case default
69-
call error_stop("ERROR (mean): wrong dimension")
70-
end select
71-
72-
end function mean_2_${k1}$_${k1}$
73-
#:endfor
74-
75-
76-
#:for k1, t1 in INT_KINDS_TYPES
77-
module function mean_2_${k1}$_dp(x, dim) result(res)
78-
${t1}$, intent(in) :: x(:,:)
79-
integer, intent(in) :: dim
80-
real(dp) :: res(merge(size(x, 1), size(x, 2), mask = 1 < dim ))
81-
82-
select case(dim)
83-
case(1)
84-
res = sum(real(x, dp), 1) / real(size(x, 1), dp)
85-
case(2)
86-
res = sum(real(x, dp), 2) / real(size(x, 2), dp)
87-
case default
88-
call error_stop("ERROR (mean): wrong dimension")
89-
end select
90-
91-
end function mean_2_${k1}$_dp
92-
#:endfor
93-
94-
9513
#:for k1, t1 in REAL_KINDS_TYPES
9614
#:for rank in RANKS
9715
module function mean_${rank}$_all_${k1}$_${k1}$(x) result(res)
@@ -123,22 +41,13 @@ contains
12341
module function mean_${rank}$_${k1}$_${k1}$(x, dim) result(res)
12442
${t1}$, intent(in) :: x${ranksuffix(rank)}$
12543
integer, intent(in) :: dim
126-
${t1}$ :: res( &
127-
#:for imerge in range(1,rank-1)
128-
merge(size(x,${imerge}$),size(x,${imerge + 1}$),&
129-
& mask = ${imerge}$ < dim ), &
130-
#:endfor
131-
& merge(size(x,${rank-1}$),size(x,${rank}$),&
132-
& mask = ${rank-1}$ < dim ))
133-
134-
select case(dim)
135-
#:for fi in range(1,rank+1)
136-
case(${fi}$)
137-
res=sum(x, ${fi}$) / real(size(x, ${fi}$), ${k1}$)
138-
#:endfor
139-
case default
44+
${t1}$ :: res${reduced_shape('x', rank, 'dim')}$
45+
46+
if (dim >= 1 .and. dim <= ${rank}$) then
47+
res = sum(x, dim) / real(size(x, dim), ${k1}$)
48+
else
14049
call error_stop("ERROR (mean): wrong dimension")
141-
end select
50+
end if
14251

14352
end function mean_${rank}$_${k1}$_${k1}$
14453
#:endfor
@@ -148,24 +57,15 @@ contains
14857
#:for k1, t1 in INT_KINDS_TYPES
14958
#:for rank in RANKS
15059
module function mean_${rank}$_${k1}$_dp(x, dim) result(res)
151-
${t1}$, intent(in) :: x${ranksuffix(rank)}$
152-
integer, intent(in) :: dim
153-
real(dp) :: res( &
154-
#:for imerge in range(1,rank-1)
155-
& merge(size(x, ${imerge}$), size(x, ${imerge + 1}$),&
156-
& mask = ${imerge}$ < dim ), &
157-
#:endfor
158-
& merge(size(x,${rank-1}$),size(x,${rank}$),&
159-
& mask = ${rank-1}$ < dim ))
160-
161-
select case(dim)
162-
#:for fi in range(1,rank+1)
163-
case(${fi}$)
164-
res = sum(real(x, dp), ${fi}$) / real(size(x, ${fi}$), dp)
165-
#:endfor
166-
case default
167-
call error_stop("ERROR (mean): wrong dimension")
168-
end select
60+
${t1}$, intent(in) :: x${ranksuffix(rank)}$
61+
integer, intent(in) :: dim
62+
real(dp) :: res${reduced_shape('x', rank, 'dim')}$
63+
64+
if (dim >= 1 .and. dim <= ${rank}$) then
65+
res = sum(x, dim) / real(size(x, dim), dp)
66+
else
67+
call error_stop("ERROR (mean): wrong dimension")
68+
end if
16969

17070
end function mean_${rank}$_${k1}$_dp
17171
#:endfor

0 commit comments

Comments
 (0)