Merge pull request fortran-lang#191 from jvdp1/corr

Pearson correlation among elements of an array

Author: jvdp1

doc/specs/stdlib_experimental_stats.md

@@ -6,6 +6,54 @@ title: experimental_stats
 
 [TOC]
 
+## `corr` - Pearson correlation of array elements
+
+### Description
+
+Returns the Pearson correlation of the elements of `array` along dimension `dim` if the corresponding element in `mask` is `true`.
+
+The Pearson correlation between two rows (or columns), say `x` and `y`, of `array` is defined as:
+
+```
+ corr(x, y) = cov(x, y) / sqrt( var(x) * var(y))
+```
+
+### Syntax
+
+`result = [[stdlib_experimental_stats(module):corr(interface)]](array, dim [, mask])`
+
+### Arguments
+
+`array`: Shall be a rank-1 or a rank-2 array of type `integer`, `real`, or `complex`.
+
+`dim`: Shall be a scalar of type `integer` with a value in the range from 1 to `n`, where `n` is the rank of `array`.
+
+`mask` (optional): Shall be of type `logical` and either a scalar or an array of the same shape as `array`.
+
+### Return value
+
+If `array` is of rank 1 and of type `real` or `complex`, the result is of type `real` and has the same kind as `array`.
+If `array` is of rank 2 and of type `real` or `complex`, the result is of the same type and kind as `array`.
+If `array` is of type `integer`, the result is of type `real(dp)`.
+
+If `array` is of rank 1 and of size larger than 1, a scalar equal to 1 is returned. Otherwise, IEEE `NaN` is returned.
+If `array` is of rank 2, a rank-2 array  with the corresponding correlations is returned.
+
+If `mask` is specified, the result is the Pearson correlation of all elements of `array` corresponding to `true` elements of `mask`. If every element of `mask` is `false`, the result is IEEE `NaN`.
+
+### Example
+
+```fortran
+program demo_corr
+    use stdlib_experimental_stats, only: corr
+    implicit none
+    real :: x(1:6) = [ 1., 2., 3., 4., 5., 6. ]
+    real :: y(1:2, 1:3) = reshape([ -1., 40., -3., 4., 10., 6. ], [ 2, 3])
+    print *, corr(x, 1)           !returns 1.
+    print *, corr(y, 2)           !returns reshape([ 1., -.32480, -.32480, 1. ], [ 2, 3])
+end program demo_corr
+```
+
 ## `cov` - covariance of array elements
 
 ### Description
@@ -233,4 +281,3 @@ program demo_var
     print *, var(y, 1, y > 3., corrected=.false.)    !returns [NaN, 0., 0.25]
 end program demo_var
 ```
-

src/CMakeLists.txt

@@ -7,6 +7,7 @@ set(fppFiles
     stdlib_experimental_linalg_diag.fypp
     stdlib_experimental_optval.fypp
     stdlib_experimental_stats.fypp
+    stdlib_experimental_stats_corr.fypp
     stdlib_experimental_stats_cov.fypp
     stdlib_experimental_stats_mean.fypp
     stdlib_experimental_stats_moment.fypp

src/stdlib_experimental_stats.fypp

@@ -11,11 +11,102 @@ module stdlib_experimental_stats
   implicit none
   private
   ! Public API
-  public :: cov, mean, moment, var
+  public :: corr, cov, mean, moment, var
+
+
+  interface corr
+    !! Pearson correlation of array elements
+    !! ([Specification](../page/specs/stdlib_experimental_stats.html#description))
+    #:for k1, t1 in RC_KINDS_TYPES
+      #:set RName = rname("corr",1, t1, k1)
+      module function ${RName}$(x, dim, mask) result(res)
+        ${t1}$, intent(in) :: x(:)
+        integer, intent(in) :: dim
+        logical, intent(in), optional :: mask
+        real(${k1}$) :: res
+      end function ${RName}$
+    #:endfor
+
+    #:for k1, t1 in INT_KINDS_TYPES
+      #:set RName = rname("corr",1, t1, k1, 'dp')
+      module function ${RName}$(x, dim, mask) result(res)
+        ${t1}$, intent(in) :: x(:)
+        integer, intent(in) :: dim
+        logical, intent(in), optional :: mask
+        real(dp) :: res
+      end function ${RName}$
+    #:endfor
+
+    #:for k1, t1 in RC_KINDS_TYPES
+      #:set RName = rname("corr_mask",1, t1, k1)
+      module function ${RName}$(x, dim, mask) result(res)
+        ${t1}$, intent(in) :: x(:)
+        integer, intent(in) :: dim
+        logical, intent(in) :: mask(:)
+        real(${k1}$) :: res
+      end function ${RName}$
+    #:endfor
+
+    #:for k1, t1 in INT_KINDS_TYPES
+      #:set RName = rname("corr_mask",1, t1, k1, 'dp')
+      module function ${RName}$(x, dim, mask) result(res)
+        ${t1}$, intent(in) :: x(:)
+        integer, intent(in) :: dim
+        logical, intent(in) :: mask(:)
+        real(dp) :: res
+      end function ${RName}$
+    #:endfor
+
+    #:for k1, t1 in RC_KINDS_TYPES
+      #:set RName = rname("corr",2, t1, k1)
+      module function ${RName}$(x, dim, mask) result(res)
+        ${t1}$, intent(in) :: x(:, :)
+        integer, intent(in) :: dim
+        logical, intent(in), optional :: mask
+        ${t1}$ :: res(merge(size(x, 1), size(x, 2), mask = 1<dim)&
+                            , merge(size(x, 1), size(x, 2), mask = 1<dim))
+      end function ${RName}$
+    #:endfor
+
+    #:for k1, t1 in INT_KINDS_TYPES
+      #:set RName = rname("corr",2, t1, k1, 'dp')
+      module function ${RName}$(x, dim, mask) result(res)
+        ${t1}$, intent(in) :: x(:, :)
+        integer, intent(in) :: dim
+        logical, intent(in), optional :: mask
+        real(dp) :: res(merge(size(x, 1), size(x, 2), mask = 1<dim)&
+                        , merge(size(x, 1), size(x, 2), mask = 1<dim))
+      end function ${RName}$
+    #:endfor
+
+    #:for k1, t1 in RC_KINDS_TYPES
+      #:set RName = rname("corr_mask",2, t1, k1)
+      module function ${RName}$(x, dim, mask) result(res)
+        ${t1}$, intent(in) :: x(:, :)
+        integer, intent(in) :: dim
+        logical, intent(in) :: mask(:,:)
+        ${t1}$ :: res(merge(size(x, 1), size(x, 2), mask = 1<dim)&
+                            , merge(size(x, 1), size(x, 2), mask = 1<dim))
+      end function ${RName}$
+    #:endfor
+
+    #:for k1, t1 in INT_KINDS_TYPES
+      #:set RName = rname("corr_mask",2, t1, k1, 'dp')
+      module function ${RName}$(x, dim, mask) result(res)
+        ${t1}$, intent(in) :: x(:, :)
+        integer, intent(in) :: dim
+        logical, intent(in) :: mask(:,:)
+        real(dp) :: res(merge(size(x, 1), size(x, 2), mask = 1<dim)&
+                            , merge(size(x, 1), size(x, 2), mask = 1<dim))
+      end function ${RName}$
+    #:endfor
+
+  end interface corr
+
 
   interface cov
     !! Covariance of array elements
-    !! ([Specification](../page/specs/stdlib_experimental_stats.html#description))
+    !! ([Specification](../page/specs/stdlib_experimental_stats.html#description_1))
     #:for k1, t1 in RC_KINDS_TYPES
       #:set RName = rname("cov",1, t1, k1)
       module function ${RName}$(x, dim, mask, corrected) result(res)
@@ -112,7 +203,7 @@ module stdlib_experimental_stats
 
   interface mean
     !! Mean of array elements
-    !! ([Specification](../page/specs/stdlib_experimental_stats.html#description_1))
+    !! ([Specification](../page/specs/stdlib_experimental_stats.html#description_2))
     #:for k1, t1 in RC_KINDS_TYPES
       #:for rank in RANKS
         #:set RName = rname("mean_all",rank, t1, k1)
@@ -210,7 +301,7 @@ module stdlib_experimental_stats
 
   interface var
     !! Variance of array elements
-    !! ([Specification](../page/specs/stdlib_experimental_stats.html#description_3))
+    !! ([Specification](../page/specs/stdlib_experimental_stats.html#description_4))
 
     #:for k1, t1 in RC_KINDS_TYPES
       #:for rank in RANKS
@@ -317,7 +408,7 @@ module stdlib_experimental_stats
 
   interface moment
     !! Central moment of array elements
-    !! ([Specification](../page/specs/stdlib_experimental_stats.html#description_2))
+    !! ([Specification](../page/specs/stdlib_experimental_stats.html#description_3))
     #:for k1, t1 in RC_KINDS_TYPES
       #:for rank in RANKS
         #:set RName = rname("moment_all",rank, t1, k1)