From 8ea855733912dde79f9f912f95f4ca68651b732c Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 2 Jul 2019 11:20:15 +0200 Subject: [PATCH 1/4] Bugfix for issue #227. --- R/Ano.R | 36 +++++++++++++++++++++++++++++++++--- 1 file changed, 33 insertions(+), 3 deletions(-) diff --git a/R/Ano.R b/R/Ano.R index 4b2b8767..9e5c38da 100644 --- a/R/Ano.R +++ b/R/Ano.R @@ -4,26 +4,56 @@ Ano <- function(var, clim) { # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # dimvar <- dim(var) - + if (length(dim(clim)) <= 2) { clim <- InsertDim(clim, 2, dimvar[2]) } + if ((length(dimvar) > length(dim(clim))) & (dim(clim)[2] != dimvar[2])) { clim <- InsertDim(clim, 2, dimvar[2]) } + if ((length(dimvar) > length(dim(clim))) & (dim(clim)[2] == dimvar[2])) { + if (is.null(names(dim(clim))) | is.null(names(dimvar))) { + stop('The dimensions have the same length. To clarify if they are the same variable, add dimension names to the arrays.') + } else { + if (names(dim(clim)[2]) != names(dimvar[2])) { + clim <- InsertDim(clim, 2, dimvar[2]) + } + } + } + if ((length(dimvar) > length(dim(clim))) & (dim(clim)[3] != dimvar[3])) { clim <- InsertDim(clim, 3, dimvar[3]) } + if ((length(dimvar) > length(dim(clim))) & (dim(clim)[3] == dimvar[3])) { + if (is.null(names(dim(clim))) | is.null(names(dimvar))) { + stop('The dimensions have the same length. To clarify if they are the same variable, add dimension names to the arrays.') + } else { + if (names(dim(clim)[3]) != names(dimvar[3])) { + clim <- InsertDim(clim, 3, dimvar[3]) + } + } + } + if ((length(dimvar) > length(dim(clim))) & (dim(clim)[4] != dimvar[4])) { clim <- InsertDim(clim, 4, dimvar[4]) } - + if ((length(dimvar) > length(dim(clim))) & (dim(clim)[4] == dimvar[4])) { + if (is.null(names(dim(clim))) | is.null(names(dimvar))) { + stop('The dimensions have the same length. To clarify if they are the same variable, add dimension names to the arrays.') + } else { + if (names(dim(clim)[4]) != names(dimvar[4])) { + clim <- InsertDim(clim, 4, dimvar[4]) + } + } + } + # # Raw anomalies # ~~~~~~~~~~~~~~~ # ano <- var - clim - + # # Outputs # ~~~~~~~~~ -- GitLab From dc6688cfec12c546136efdaca2bafa0b42e7eda1 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 19 Jul 2019 18:19:20 +0200 Subject: [PATCH 2/4] Add unit tests --- tests/testthat/test-Ano.R | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 tests/testthat/test-Ano.R diff --git a/tests/testthat/test-Ano.R b/tests/testthat/test-Ano.R new file mode 100644 index 00000000..4d483e01 --- /dev/null +++ b/tests/testthat/test-Ano.R @@ -0,0 +1,28 @@ +context("Generic tests") +test_that("Sanity checks", { + + var <- array(rnorm(16), c(2, 2, 2, 2)) + names(dim(var)) <- c("memb", "lon", "sdates", "lat") + clim <- apply(var, c(1, 2, 4), mean) + names(dim(clim)) <- NULL + expect_error( + Ano(var, clim), + "Provide dimension names on parameter \'var\' and \'clim\' to avoid ambiguity." + ) + + t <- array(rnorm(76), c(1, 3, 4, 3, 2, 2)) + names(dim(t)) <- c("mod", "memb", "sdates", "ltime", "lon", "lat") + c3 <- Clim(t, t, memb = TRUE)$clim_exp # Clim for each member + c1 <- InsertDim(c3[, 1, ,, ], 1, 1) # clim as if memb=FALSE but identical to member 1 + names(dim(c1)) <- c("mod", "ltime", "lon", "lat") + identical(c1[, , , ], c3[, 1, , , ]) # results in TRUE + a3 <- Ano(t, c3) # ano for each member individually + a1 <- Ano(t, c1) # ano for first member + identical(a1[, 1, , , , ], a3[, 1, , , , ]) + + expect_equal( + which(a1[, 1, , , , ], + a3[, 1, , , , ]) + ) + +}) -- GitLab From 4245975d673ddfcee1e2bc8da5cf64b72f140c44 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 19 Jul 2019 18:20:13 +0200 Subject: [PATCH 3/4] Revise stop messages. --- R/Ano.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/Ano.R b/R/Ano.R index 9e5c38da..ed3350a2 100644 --- a/R/Ano.R +++ b/R/Ano.R @@ -14,7 +14,7 @@ Ano <- function(var, clim) { } if ((length(dimvar) > length(dim(clim))) & (dim(clim)[2] == dimvar[2])) { if (is.null(names(dim(clim))) | is.null(names(dimvar))) { - stop('The dimensions have the same length. To clarify if they are the same variable, add dimension names to the arrays.') + stop('Provide dimension names on parameter \'var\' and \'clim\' to avoid ambiguity.') } else { if (names(dim(clim)[2]) != names(dimvar[2])) { clim <- InsertDim(clim, 2, dimvar[2]) @@ -27,7 +27,7 @@ Ano <- function(var, clim) { } if ((length(dimvar) > length(dim(clim))) & (dim(clim)[3] == dimvar[3])) { if (is.null(names(dim(clim))) | is.null(names(dimvar))) { - stop('The dimensions have the same length. To clarify if they are the same variable, add dimension names to the arrays.') + stop('Provide dimension names on parameter \'var\' and \'clim\' to avoid ambiguity.') } else { if (names(dim(clim)[3]) != names(dimvar[3])) { clim <- InsertDim(clim, 3, dimvar[3]) @@ -40,7 +40,7 @@ Ano <- function(var, clim) { } if ((length(dimvar) > length(dim(clim))) & (dim(clim)[4] == dimvar[4])) { if (is.null(names(dim(clim))) | is.null(names(dimvar))) { - stop('The dimensions have the same length. To clarify if they are the same variable, add dimension names to the arrays.') + stop('Provide dimension names on parameter \'var\' and \'clim\' to avoid ambiguity.') } else { if (names(dim(clim)[4]) != names(dimvar[4])) { clim <- InsertDim(clim, 4, dimvar[4]) -- GitLab From 6d18d9dcce196006954effa7a30dd1792686b8b6 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 19 Jul 2019 18:36:51 +0200 Subject: [PATCH 4/4] Bug fix. --- tests/testthat/test-Ano.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-Ano.R b/tests/testthat/test-Ano.R index 4d483e01..aa3d2796 100644 --- a/tests/testthat/test-Ano.R +++ b/tests/testthat/test-Ano.R @@ -18,11 +18,10 @@ test_that("Sanity checks", { identical(c1[, , , ], c3[, 1, , , ]) # results in TRUE a3 <- Ano(t, c3) # ano for each member individually a1 <- Ano(t, c1) # ano for first member - identical(a1[, 1, , , , ], a3[, 1, , , , ]) expect_equal( - which(a1[, 1, , , , ], - a3[, 1, , , , ]) + a1[, 1, , , , ], + a3[, 1, , , , ] ) }) -- GitLab