stat_dev: addition of test and creation of modules and submodules with fypp

how to use pure functions inside submodules

Author: jvdp1

src/stdlib_experimental_stat.f90

@@ -1,4 +1,6 @@
 module stdlib_experimental_stat
+
+
 use stdlib_experimental_kinds, only: sp, dp, qp
 implicit none
 private
@@ -7,15 +9,34 @@ module stdlib_experimental_stat
 
 
 interface mean
+    module function mean_1_sp_sp(mat) result(res)
+        real(sp), intent(in) :: mat(:)
+        real(sp) ::res
+    end function mean_1_sp_sp
     module function mean_1_dp_dp(mat) result(res)
         real(dp), intent(in) :: mat(:)
         real(dp) ::res
-    end function
+    end function mean_1_dp_dp
+    module function mean_1_qp_qp(mat) result(res)
+        real(qp), intent(in) :: mat(:)
+        real(qp) ::res
+    end function mean_1_qp_qp
+
+    module function mean_2_sp_sp(mat, dim) result(res)
+        real(sp), intent(in) :: mat(:,:)
+        integer, intent(in), optional :: dim
+        real(sp), allocatable ::res(:)
+    end function mean_2_sp_sp
     module function mean_2_dp_dp(mat, dim) result(res)
         real(dp), intent(in) :: mat(:,:)
         integer, intent(in), optional :: dim
         real(dp), allocatable ::res(:)
-    end function
+    end function mean_2_dp_dp
+    module function mean_2_qp_qp(mat, dim) result(res)
+        real(qp), intent(in) :: mat(:,:)
+        integer, intent(in), optional :: dim
+        real(qp), allocatable ::res(:)
+    end function mean_2_qp_qp
 end interface
 
 end module

src/stdlib_experimental_stat.fypp.f90

@@ -0,0 +1,32 @@
+module stdlib_experimental_stat
+
+#:set REALKINDS = ["sp", "dp", "qp"]
+#:set KINDS = REALKINDS
+#:set TYPES = ["real({})".format(k) for k in REALKINDS]
+#:set ikt = list(zip(range(len(KINDS)), KINDS, TYPES))
+
+use stdlib_experimental_kinds, only: sp, dp, qp
+implicit none
+private
+! Public API
+public :: mean
+
+
+interface mean
+#:for i1, k1, t1 in ikt
+    module function mean_1_${k1}$_${k1}$(mat) result(res)
+        ${t1}$, intent(in) :: mat(:)
+        ${t1}$ ::res
+    end function mean_1_${k1}$_${k1}$
+#:endfor
+
+#:for i1, k1, t1 in ikt
+    module function mean_2_${k1}$_${k1}$(mat, dim) result(res)
+        ${t1}$, intent(in) :: mat(:,:)
+        integer, intent(in), optional :: dim
+        ${t1}$, allocatable ::res(:)
+    end function mean_2_${k1}$_${k1}$
+#:endfor
+end interface
+
+end module

src/stdlib_experimental_stat_mean.f90

@@ -1,17 +1,56 @@
 submodule (stdlib_experimental_stat) stdlib_experimental_stat_mean
+
+
 use stdlib_experimental_optval, only: optval
 implicit none
 
 contains
 
+module function mean_1_sp_sp(mat) result(res)
+    real(sp), intent(in) :: mat(:)
+    real(sp) ::res
+
+    res = sum(mat) / real(size(mat), sp)
+
+end function mean_1_sp_sp
 module function mean_1_dp_dp(mat) result(res)
     real(dp), intent(in) :: mat(:)
     real(dp) ::res
 
     res = sum(mat) / real(size(mat), dp)
 
 end function mean_1_dp_dp
+module function mean_1_qp_qp(mat) result(res)
+    real(qp), intent(in) :: mat(:)
+    real(qp) ::res
+
+    res = sum(mat) / real(size(mat), qp)
+
+end function mean_1_qp_qp
+
+module function mean_2_sp_sp(mat, dim) result(res)
+    real(sp), intent(in) :: mat(:,:)
+    integer, intent(in), optional :: dim
+    real(sp), allocatable ::res(:)
+
+    integer :: i
+    integer :: dim_
+
+    dim_ = optval(dim, 1)
+
+    allocate(res(size(mat, dim_)))
+
+    if (dim_ == 1) then
+        do i=1, size(mat, dim_)
+            res(i) = mean_1_sp_sp(mat(i,:))
+        end do
+    else if (dim_ == 2) then
+        do i=1, size(mat, dim_)
+            res(i) = mean_1_sp_sp(mat(:,i))
+        end do
+    end if
 
+end function mean_2_sp_sp
 module function mean_2_dp_dp(mat, dim) result(res)
     real(dp), intent(in) :: mat(:,:)
     integer, intent(in), optional :: dim
@@ -35,5 +74,28 @@ module function mean_2_dp_dp(mat, dim) result(res)
     end if
 
 end function mean_2_dp_dp
+module function mean_2_qp_qp(mat, dim) result(res)
+    real(qp), intent(in) :: mat(:,:)
+    integer, intent(in), optional :: dim
+    real(qp), allocatable ::res(:)
+
+    integer :: i
+    integer :: dim_
+
+    dim_ = optval(dim, 1)
+
+    allocate(res(size(mat, dim_)))
+
+    if (dim_ == 1) then
+        do i=1, size(mat, dim_)
+            res(i) = mean_1_qp_qp(mat(i,:))
+        end do
+    else if (dim_ == 2) then
+        do i=1, size(mat, dim_)
+            res(i) = mean_1_qp_qp(mat(:,i))
+        end do
+    end if
+
+end function mean_2_qp_qp
 
 end submodule

src/stdlib_experimental_stat_mean.fypp.f90

@@ -0,0 +1,49 @@
+submodule (stdlib_experimental_stat) stdlib_experimental_stat_mean
+
+#:set REALKINDS = ["sp", "dp", "qp"]
+#:set KINDS = REALKINDS
+#:set TYPES = ["real({})".format(k) for k in REALKINDS]
+#:set ikt = list(zip(range(len(KINDS)), KINDS, TYPES))
+
+use stdlib_experimental_optval, only: optval
+implicit none
+
+contains
+
+#:for i1, k1, t1 in ikt
+module function mean_1_${k1}$_${k1}$(mat) result(res)
+    ${t1}$, intent(in) :: mat(:)
+    ${t1}$ ::res
+
+    res = sum(mat) / real(size(mat), ${k1}$)
+
+end function mean_1_${k1}$_${k1}$
+#:endfor
+
+#:for i1, k1, t1 in ikt
+module function mean_2_${k1}$_${k1}$(mat, dim) result(res)
+    ${t1}$, intent(in) :: mat(:,:)
+    integer, intent(in), optional :: dim
+    ${t1}$, allocatable ::res(:)
+
+    integer :: i
+    integer :: dim_
+
+    dim_ = optval(dim, 1)
+
+    allocate(res(size(mat, dim_)))
+
+    if (dim_ == 1) then
+        do i=1, size(mat, dim_)
+            res(i) = mean_1_${k1}$_${k1}$(mat(i,:))
+        end do
+    else if (dim_ == 2) then
+        do i=1, size(mat, dim_)
+            res(i) = mean_1_${k1}$_${k1}$(mat(:,i))
+        end do
+    end if
+
+end function mean_2_${k1}$_${k1}$
+#:endfor
+
+end submodule

src/tests/stat/test_mean.f90

@@ -3,57 +3,24 @@ program test_mean
 use stdlib_experimental_kinds, only: sp, dp
 use stdlib_experimental_io, only: loadtxt
 use stdlib_experimental_stat, only: mean
-use stdlib_experimental_error, only: error_stop
 implicit none
 
 real(sp), allocatable :: s(:, :)
 real(dp), allocatable :: d(:, :)
-real(dp), allocatable :: res(:)
 
-!call loadtxt("array1.dat", s)
-!call print_array(s)
+!sp
+call loadtxt("array1.dat", s)
 
+call assert(sum( mean(s) - [1.5_sp, 3.5_sp, 5.5_sp, 7.5_sp] ) == 0.0_sp)
+call assert(sum( mean(s, dim = 2) - [4.0_sp, 5.0_sp] ) == 0.0_sp)
+
+!dp
 call loadtxt("array1.dat", d)
 
-res = mean(d)
-call print_array(d)
-print *,'Mean = ', res
-call assert(sum( res - [1.5_dp, 3.5_dp, 5.5_dp, 7.5_dp] ) == 0.0_dp)
-
-res = mean(d, dim = 2)
-call print_array(d)
-print *,'Mean = ', res
-call assert(sum( res - [4.0_dp, 5.0_dp] ) == 0.0_dp)
-
-!call loadtxt("array2.dat", d)
-!call print_array(d)
-!
-!call loadtxt("array3.dat", d)
-!call print_array(d)
-!
-!call loadtxt("array4.dat", d)
-!call print_array(d)
+call assert(sum( mean(d) - [1.5_dp, 3.5_dp, 5.5_dp, 7.5_dp] ) == 0.0_dp)
+call assert(sum( mean(d, dim = 2) - [4.0_dp, 5.0_dp] ) == 0.0_dp)
 
-contains
 
-subroutine print_array(a)
-class(*),intent(in) :: a(:, :)
-integer :: i
-print *, "Array, shape=(", size(a, 1), ",", size(a, 2), ")"
-
- select type(a)
-  type is(real(sp))
-   do i = 1, size(a, 1)
-    print *, a(i, :)
-   end do
-  type is(real(dp))
-   do i = 1, size(a, 1)
-    print *, a(i, :)
-   end do
-  class default
-   call error_stop('The proposed type is not supported')
- end select
-
-end subroutine
+contains
 
 end program