Skip to content

Commit 7c33e00

Browse files
jvdp1jvdp1
committed
moment_dev: addition of tests for complex
1 parent 6c2630b commit 7c33e00

File tree

3 files changed

+113
-27
lines changed

3 files changed

+113
-27
lines changed

‎src/stdlib_experimental_stats.fypp

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -217,7 +217,7 @@ module stdlib_experimental_stats
217217
${t1}$, intent(in) :: x${ranksuffix(rank)}$
218218
integer, intent(in) :: order
219219
logical, intent(in), optional :: mask
220-
real(${k1}$) :: res
220+
${t1}$ :: res
221221
end function ${RName}$
222222
#:endfor
223223
#:endfor
@@ -242,7 +242,7 @@ module stdlib_experimental_stats
242242
integer, intent(in) :: order
243243
integer, intent(in) :: dim
244244
logical, intent(in), optional :: mask
245-
real(${k1}$) :: res${reduced_shape('x', rank, 'dim')}$
245+
${t1}$ :: res${reduced_shape('x', rank, 'dim')}$
246246
end function ${RName}$
247247
#:endfor
248248
#:endfor
@@ -267,7 +267,7 @@ module stdlib_experimental_stats
267267
${t1}$, intent(in) :: x${ranksuffix(rank)}$
268268
integer, intent(in) :: order
269269
logical, intent(in) :: mask${ranksuffix(rank)}$
270-
real(${k1}$) :: res
270+
${t1}$ :: res
271271
end function ${RName}$
272272
#:endfor
273273
#:endfor
@@ -292,7 +292,7 @@ module stdlib_experimental_stats
292292
integer, intent(in) :: order
293293
integer, intent(in) :: dim
294294
logical, intent(in) :: mask${ranksuffix(rank)}$
295-
real(${k1}$) :: res${reduced_shape('x', rank, 'dim')}$
295+
${t1}$ :: res${reduced_shape('x', rank, 'dim')}$
296296
end function ${RName}$
297297
#:endfor
298298
#:endfor

‎src/stdlib_experimental_stats_moment.fypp

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ contains
1717
${t1}$, intent(in) :: x${ranksuffix(rank)}$
1818
integer, intent(in) :: order
1919
logical, intent(in), optional :: mask
20-
real(${k1}$) :: res
20+
${t1}$ :: res
2121

2222
real(${k1}$) :: n
2323
${t1}$ :: mean
@@ -71,7 +71,7 @@ contains
7171
integer, intent(in) :: order
7272
integer, intent(in) :: dim
7373
logical, intent(in), optional :: mask
74-
real(${k1}$) :: res${reduced_shape('x', rank, 'dim')}$
74+
${t1}$ :: res${reduced_shape('x', rank, 'dim')}$
7575

7676
integer :: i
7777
real(${k1}$) :: n
@@ -148,7 +148,7 @@ contains
148148
${t1}$, intent(in) :: x${ranksuffix(rank)}$
149149
integer, intent(in) :: order
150150
logical, intent(in) :: mask${ranksuffix(rank)}$
151-
real(${k1}$) :: res
151+
${t1}$ :: res
152152

153153
real(${k1}$) :: n
154154
${t1}$ :: mean
@@ -192,7 +192,7 @@ contains
192192
integer, intent(in) :: order
193193
integer, intent(in) :: dim
194194
logical, intent(in) :: mask${ranksuffix(rank)}$
195-
real(${k1}$) :: res${reduced_shape('x', rank, 'dim')}$
195+
${t1}$ :: res${reduced_shape('x', rank, 'dim')}$
196196

197197
integer :: i
198198
real(${k1}$) :: n${reduced_shape('x', rank, 'dim')}$

‎src/tests/stats/test_moment.f90

Lines changed: 105 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
program test_moment
22
use stdlib_experimental_error, only: assert
33
use stdlib_experimental_kinds, only: sp, dp, int32, int64
4-
use stdlib_experimental_stats, only: mean, moment, var
4+
use stdlib_experimental_stats, only: moment
55
implicit none
66

77

@@ -19,20 +19,19 @@ program test_moment
1919
cmplx(1.26401_sp, 0.00000_sp),&
2020
cmplx(0.00000_sp, 0.88833_sp),&
2121
cmplx(1.14352_sp, 0.00000_sp)]
22-
complex(dp) :: cd1(5) = [ cmplx(0.57706_dp, 0.00000_dp),&
23-
cmplx(0.00000_dp, 1.44065_dp),&
24-
cmplx(1.26401_dp, 0.00000_dp),&
25-
cmplx(0.00000_dp, 0.88833_dp),&
26-
cmplx(1.14352_dp, 0.00000_dp)]
2722
complex(sp) :: cs(5,3)
28-
complex(dp) :: cd(5,3)
2923

3024

3125
call test_sp(real(d1,sp), real(d,sp))
3226
call test_dp(d1, d)
3327
call test_int32(int(d1, int32), int(d, int32))
3428
call test_int64(int(d1, int64), int(d, int64))
3529

30+
cs(:,1) = cs1
31+
cs(:,2) = cs1*3_sp
32+
cs(:,3) = cs1*1.5_sp
33+
call test_csp(cs1, cs)
34+
3635

3736
contains
3837
subroutine test_sp(x1, x2)
@@ -161,17 +160,17 @@ subroutine test_sp(x1, x2)
161160

162161
print*,' test_sp_3dim_mask_array', order
163162
call assert( abs(moment(x3, order, x3 < 11) - 7.7370242214532876_dp ) < sptol)
164-
call assert( all( abs( var(x3, 1, x3 < 45, corrected=.false.) -&
163+
call assert( all( abs( moment(x3, order, 1, x3 < 45) -&
165164
reshape([5._sp, 5._sp, 1.25_sp, 20._sp, 20._sp, 5._sp,&
166165
80._sp, 80._sp, 32._sp/3.],&
167166
[size(x3, 2), size(x3, 3)])) < sptol ))
168-
call assert( all( abs( var(x3, 2, x3 < 45, corrected=.false.) -&
167+
call assert( all( abs( moment(x3, order, 2, x3 < 45) -&
169168
reshape([ 38._sp/3., 86._sp/9., 62._sp/9., 14._sp/3., 152._sp/3.,&
170169
344._sp/9., 248._sp/9., 168._sp/9., 1824._sp/9.,&
171170
1376._sp/9., 992._sp/9., 4._sp&
172171
],&
173172
[size(x3, 1), size(x3, 3)])) < sptol ))
174-
call assert( all( abs( var(x3, 3, x3 < 45, corrected=.false.) -&
173+
call assert( all( abs( moment(x3, order, 3, x3 < 45) -&
175174
reshape([14._sp/9., 14._sp, 350._sp/9., 686._sp/9., 56._sp/9.,&
176175
224._sp/9., 56._sp, 896._sp/9., 126._sp, 1400._sp/9.,&
177176
1694._sp/9., 36._sp&
@@ -307,17 +306,17 @@ subroutine test_dp(x1, x2)
307306

308307
print*,' test_dp_3dim_mask_array', order
309308
call assert( abs(moment(x3, order, x3 < 11) - 7.7370242214532876_dp ) < dptol)
310-
call assert( all( abs( var(x3, 1, x3 < 45, corrected=.false.) -&
309+
call assert( all( abs( moment(x3, order, 1, x3 < 45) -&
311310
reshape([5._dp, 5._dp, 1.25_dp, 20._dp, 20._dp, 5._dp,&
312311
80._dp, 80._dp, 32._dp/3.],&
313312
[size(x3, 2), size(x3, 3)])) < dptol ))
314-
call assert( all( abs( var(x3, 2, x3 < 45, corrected=.false.) -&
313+
call assert( all( abs( moment(x3, order, 2, x3 < 45) -&
315314
reshape([ 38._dp/3., 86._dp/9., 62._dp/9., 14._dp/3., 152._dp/3.,&
316315
344._dp/9., 248._dp/9., 168._dp/9., 1824._dp/9.,&
317316
1376._dp/9., 992._dp/9., 4._dp&
318317
],&
319318
[size(x3, 1), size(x3, 3)])) < dptol ))
320-
call assert( all( abs( var(x3, 3, x3 < 45, corrected=.false.) -&
319+
call assert( all( abs( moment(x3, order, 3, x3 < 45) -&
321320
reshape([14._dp/9., 14._dp, 350._dp/9., 686._dp/9., 56._dp/9.,&
322321
224._dp/9., 56._dp, 896._dp/9., 126._dp, 1400._dp/9.,&
323322
1694._dp/9., 36._dp&
@@ -453,17 +452,17 @@ subroutine test_int32(x1, x2)
453452

454453
print*,' test_dp_3dim_mask_array', order
455454
call assert( abs(moment(x3, order, x3 < 11) - 7.7370242214532876_dp ) < dptol)
456-
call assert( all( abs( var(x3, 1, x3 < 45, corrected=.false.) -&
455+
call assert( all( abs( moment(x3, order, 1, x3 < 45) -&
457456
reshape([5._dp, 5._dp, 1.25_dp, 20._dp, 20._dp, 5._dp,&
458457
80._dp, 80._dp, 32._dp/3.],&
459458
[size(x3, 2), size(x3, 3)])) < dptol ))
460-
call assert( all( abs( var(x3, 2, x3 < 45, corrected=.false.) -&
459+
call assert( all( abs( moment(x3, order, 2, x3 < 45) -&
461460
reshape([ 38._dp/3., 86._dp/9., 62._dp/9., 14._dp/3., 152._dp/3.,&
462461
344._dp/9., 248._dp/9., 168._dp/9., 1824._dp/9.,&
463462
1376._dp/9., 992._dp/9., 4._dp&
464463
],&
465464
[size(x3, 1), size(x3, 3)])) < dptol ))
466-
call assert( all( abs( var(x3, 3, x3 < 45, corrected=.false.) -&
465+
call assert( all( abs( moment(x3, order, 3, x3 < 45) -&
467466
reshape([14._dp/9., 14._dp, 350._dp/9., 686._dp/9., 56._dp/9.,&
468467
224._dp/9., 56._dp, 896._dp/9., 126._dp, 1400._dp/9.,&
469468
1694._dp/9., 36._dp&
@@ -599,22 +598,109 @@ subroutine test_int64(x1, x2)
599598

600599
print*,' test_dp_3dim_mask_array', order
601600
call assert( abs(moment(x3, order, x3 < 11) - 7.7370242214532876_dp ) < dptol)
602-
call assert( all( abs( var(x3, 1, x3 < 45, corrected=.false.) -&
601+
call assert( all( abs( moment(x3, order, 1, x3 < 45) -&
603602
reshape([5._dp, 5._dp, 1.25_dp, 20._dp, 20._dp, 5._dp,&
604603
80._dp, 80._dp, 32._dp/3.],&
605604
[size(x3, 2), size(x3, 3)])) < dptol ))
606-
call assert( all( abs( var(x3, 2, x3 < 45, corrected=.false.) -&
605+
call assert( all( abs( moment(x3, order, 2, x3 < 45) -&
607606
reshape([ 38._dp/3., 86._dp/9., 62._dp/9., 14._dp/3., 152._dp/3.,&
608607
344._dp/9., 248._dp/9., 168._dp/9., 1824._dp/9.,&
609608
1376._dp/9., 992._dp/9., 4._dp&
610609
],&
611610
[size(x3, 1), size(x3, 3)])) < dptol ))
612-
call assert( all( abs( var(x3, 3, x3 < 45, corrected=.false.) -&
611+
call assert( all( abs( moment(x3, order, 3, x3 < 45) -&
613612
reshape([14._dp/9., 14._dp, 350._dp/9., 686._dp/9., 56._dp/9.,&
614613
224._dp/9., 56._dp, 896._dp/9., 126._dp, 1400._dp/9.,&
615614
1694._dp/9., 36._dp&
616615
], [size(x3,1), size(x3,2)] ))&
617616
< dptol ))
618617

619618
end subroutine
619+
620+
subroutine test_csp(x1, x2)
621+
complex(sp), intent(in) :: x1(:), x2(:, :)
622+
623+
integer :: order
624+
complex(sp), allocatable :: x3(:, :, :)
625+
626+
order = 1
627+
628+
!1dim
629+
print*,' test_sp_1dim', order
630+
call assert( abs(moment(x1, order)) < sptol)
631+
call assert( abs(moment(x1, order, dim=1)) < sptol)
632+
633+
print*,' test_sp_1dim_mask', order
634+
call assert( isnan(abs(moment(x1, order, .false.))))
635+
call assert( isnan(abs(moment(x1, order, 1, .false.))))
636+
637+
print*,' test_sp_1dim_mask_array', order
638+
call assert( abs(moment(x1, order, aimag(x1) == 0)) < sptol)
639+
call assert( abs(moment(x1, order, 1, aimag(x1) == 0)) < sptol)
640+
641+
!2dim
642+
print*,' test_sp_2dim', order
643+
call assert( abs(moment(x2, order)) < sptol)
644+
call assert( all( abs( moment(x2, order, 1)) < sptol))
645+
call assert( all( abs( moment(x2, order, 2)) < sptol))
646+
647+
print*,' test_sp_2dim_mask', order
648+
call assert( isnan(abs(moment(x2, order, .false.))))
649+
call assert( any(isnan(abs(moment(x2, order, 1, .false.)))))
650+
call assert( any(isnan(abs(moment(x2, order, 2, .false.)))))
651+
652+
print*,' test_sp_2dim_mask_array', order
653+
call assert( abs(moment(x2, order, aimag(x2) == 0)) < sptol)
654+
call assert( all( abs( moment(x2, order, 1, aimag(x2) == 0)) < sptol))
655+
call assert( any(isnan( abs( moment(x2, order, 2, aimag(x2) == 0)))))
656+
657+
order = 2
658+
659+
!1dim
660+
print*,' test_sp_1dim', order
661+
call assert( abs(moment(x1, order) - (-6.459422410E-02,-0.556084037)) < sptol)
662+
call assert( abs(moment(x1, order, dim=1) -&
663+
(-6.459422410E-02,-0.556084037)) < sptol)
664+
665+
print*,' test_sp_1dim_mask', order
666+
call assert( isnan(abs(moment(x1, order, .false.))))
667+
call assert( isnan(abs(moment(x1, order, 1, .false.))))
668+
669+
print*,' test_sp_1dim_mask_array', order
670+
call assert( abs(moment(x1, order, aimag(x1) == 0) -&
671+
(8.969944715E-02,0.00000000)) < sptol)
672+
call assert( abs(moment(x1, order, 1, aimag(x1) == 0) -&
673+
(8.969944715E-02,0.00000000)) < sptol)
674+
675+
!2dim
676+
print*,' test_sp_2dim', order
677+
call assert( abs(moment(x2, order) - (-0.163121477,-1.86906016)) < sptol)
678+
call assert( all( abs( moment(x2, order, 1) -&
679+
[(-6.459422410E-02,-0.556084037),&
680+
(-0.581347823,-5.00475645),&
681+
(-0.145336956,-1.25118911)]&
682+
) < sptol))
683+
call assert( all( abs( moment(x2, order, 2) -&
684+
[(0.240498722,0.00000000),&
685+
(-1.49895227,0.00000000),&
686+
(1.15390968,0.00000000),&
687+
(-0.569927275,0.00000000),&
688+
(0.944405317,0.00000000)]&
689+
) < sptol))
690+
691+
print*,' test_sp_2dim_mask', order
692+
call assert( isnan(abs(moment(x2, order, .false.))))
693+
call assert( any(isnan(abs(moment(x2, order, 1, .false.)))))
694+
call assert( any(isnan(abs(moment(x2, order, 2, .false.)))))
695+
696+
print*,' test_sp_2dim_mask_array', order
697+
call assert( abs(moment(x2, order, aimag(x2) == 0)-&
698+
(1.08109438,0.00000000)) < sptol)
699+
call assert( all( abs( moment(x2, order, 1, aimag(x2)==0) -&
700+
[(8.969944715E-02,0.00000000),&
701+
(0.807295084,0.00000000),&
702+
(0.201823771,0.00000000)]&
703+
) < sptol))
704+
705+
end subroutine
620706
end program

0 commit comments

Comments
 (0)