From 4db7cb27076b3a5beb9bdd7c5e9cd4c69866c7c8 Mon Sep 17 00:00:00 2001
From: aho <an.ho@bsc.es>
Date: Fri, 24 Nov 2023 16:16:16 +0100
Subject: [PATCH] Correct output dims when dat_dim and memb_dim are NULL

---
 R/Corr.R | 65 +++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 41 insertions(+), 24 deletions(-)

diff --git a/R/Corr.R b/R/Corr.R
index c11fcf6..744ff10 100644
--- a/R/Corr.R
+++ b/R/Corr.R
@@ -282,22 +282,27 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL,
 .Corr <- function(exp, obs, dat_dim = NULL, memb_dim = 'member',
 		  time_dim = 'sdate', method = 'pearson',
                   conf = TRUE, pval = TRUE, sign = FALSE, alpha = 0.05) {
+
+  if (is.null(dat_dim)) {
+    nexp <- 1
+    nobs <- 1
+  } else {
+    nexp <- as.numeric(dim(exp)[dat_dim])
+    nobs <- as.numeric(dim(obs)[dat_dim])
+  }
+
   if (is.null(memb_dim)) {
+    CORR <- array(dim = c(nexp = nexp, nobs = nobs))
+
     if (is.null(dat_dim)) {
       # exp: [sdate]
       # obs: [sdate]
-      nexp <- 1
-      nobs <- 1
-      CORR <- array(dim = c(nexp = nexp, nobs = nobs))
       if (any(!is.na(exp)) && sum(!is.na(obs)) > 2) {
-        CORR <- cor(exp, obs, use = "pairwise.complete.obs", method = method)
+        CORR[, ] <- cor(exp, obs, use = "pairwise.complete.obs", method = method)
       }
     } else {
       # exp: [sdate, dat_exp]
       # obs: [sdate, dat_obs]
-      nexp <- as.numeric(dim(exp)[dat_dim])
-      nobs <- as.numeric(dim(obs)[dat_dim])
-      CORR <- array(dim = c(nexp = nexp, nobs = nobs))
       for (j in 1:nobs) {
         for (y in 1:nexp) {            
           if (any(!is.na(exp[, y])) && sum(!is.na(obs[, j])) > 2) {
@@ -328,13 +333,11 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL,
     exp_memb <- as.numeric(dim(exp)[memb_dim]) # memb_dim
     obs_memb <- as.numeric(dim(obs)[memb_dim])
 
+    CORR <- array(dim = c(nexp = nexp, nobs = nobs, exp_memb = exp_memb, obs_memb = obs_memb))
+
     if (is.null(dat_dim)) {
       # exp: [sdate, memb_exp]
       # obs: [sdate, memb_obs]
-      nexp <- 1
-      nobs <- 1
-      CORR <- array(dim = c(nexp = nexp, nobs = nobs, exp_memb = exp_memb, obs_memb = obs_memb))
-
       for (j in 1:obs_memb) {
         for (y in 1:exp_memb) {
               
@@ -349,11 +352,6 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL,
     } else {
       # exp: [sdate, dat_exp, memb_exp]
       # obs: [sdate, dat_obs, memb_obs]
-      nexp <- as.numeric(dim(exp)[dat_dim])
-      nobs <- as.numeric(dim(obs)[dat_dim])
-      
-      CORR <- array(dim = c(nexp = nexp, nobs = nobs, exp_memb = exp_memb, obs_memb = obs_memb))
-
       for (j in 1:obs_memb) {
         for (y in 1:exp_memb) {
           CORR[, , y, j] <- sapply(1:nobs, function(i) {
@@ -438,14 +436,33 @@ Corr <- function(exp, obs, time_dim = 'sdate', dat_dim = NULL,
 
 ###################################  
   # Remove nexp and nobs if dat_dim = NULL
-  if (is.null(dat_dim) & !is.null(memb_dim)) {
-    dim(CORR) <- dim(CORR)[3:length(dim(CORR))]
-    if (pval) {
-      dim(p.val) <- dim(p.val)[3:length(dim(p.val))]
-    }
-    if (conf) {
-      dim(conflow) <- dim(conflow)[3:length(dim(conflow))]
-      dim(confhigh) <- dim(confhigh)[3:length(dim(confhigh))]
+  if (is.null(dat_dim)) {
+#  if (is.null(dat_dim) & !is.null(memb_dim)) {
+
+    if (length(dim(CORR)) == 2) {
+      dim(CORR) <- NULL
+      if (pval) {
+        dim(p.val) <- NULL
+      }
+      if (conf) {
+        dim(conflow) <- NULL
+        dim(confhigh) <- NULL
+      }
+      if (sign) {
+        dim(signif) <- NULL
+      }
+    } else {
+      dim(CORR) <- dim(CORR)[3:length(dim(CORR))]
+      if (pval) {
+        dim(p.val) <- dim(p.val)[3:length(dim(p.val))]
+      }
+      if (conf) {
+        dim(conflow) <- dim(conflow)[3:length(dim(conflow))]
+        dim(confhigh) <- dim(confhigh)[3:length(dim(confhigh))]
+      }
+      if (sign) {
+        dim(signif) <- dim(signif)[3:length(dim(signif))]
+      }
     }
   }
 
-- 
GitLab