From 743ac6820f8efe0c64743738cd73492707aef41b Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 18 Apr 2019 15:43:26 +0200 Subject: [PATCH 1/4] Composite of 1 element return the same element. --- R/Composite.R | 77 ++++++++++++++++++++++++++++++--------------------- 1 file changed, 46 insertions(+), 31 deletions(-) diff --git a/R/Composite.R b/R/Composite.R index b5b54914..09aa360d 100644 --- a/R/Composite.R +++ b/R/Composite.R @@ -1,39 +1,54 @@ -Composite <- function(var, occ, lag=0, eno=FALSE, fileout=NULL) { - - if ( dim(var)[3]!=length(occ) ) { stop("temporal dimension of var is not equal to length of occ") } +Composite <- function(var, occ, lag = 0, eno = FALSE, fileout = NULL) { + if ( dim(var)[3] != length(occ) ) { + stop("temporal dimension of var is not equal to length of occ.") + } K <- max(occ) - composite <- array(dim = c(dim(var)[1:2], K)) - tvalue <- array(dim = dim(var)[1:2]) - dof <- array(dim = dim(var)[1:2]) - pvalue <- array(dim = c(dim(var)[1:2], K)) - - if ( eno==TRUE ) { n_tot <- Eno(var, posdim=3) } - else { n_tot <- length(occ) } - - mean_tot <- Mean1Dim(var, posdim=3, narm=TRUE) - stdv_tot <- apply(var, c(1,2), sd, na.rm=TRUE) - - for (k in 1:K) { - indices <- which(occ==k)+lag - - toberemoved=which(0>indices|indices>dim(var)[3]) - if ( length(toberemoved) > 0 ) { indices=indices[-toberemoved] } - - if ( eno==TRUE ) { n_k <- Eno(var[,,indices], posdim=3) } - else { n_k <- length(indices) } - - composite[,,k] <- Mean1Dim(var[,,indices], posdim=3, narm=TRUE) - stdv_k <- apply(var[,,indices], c(1,2), sd, na.rm=TRUE) + composite <- array(dim = c(dim(var)[1 : 2], K)) + tvalue <- array(dim = dim(var)[1 : 2]) + dof <- array(dim = dim(var)[1 : 2]) + pvalue <- array(dim = c(dim(var)[1 : 2], K)) + + if (eno == TRUE) { + n_tot <- Eno(var, posdim = 3) + } else { + n_tot <- length(occ) + } + mean_tot <- Mean1Dim(var, posdim = 3, narm = TRUE) + stdv_tot <- apply(var, c(1, 2), sd, na.rm = TRUE) + + for (k in 1 : K) { + + indices <- which(occ == k) + lag + toberemoved = which(0 > indices | indices > dim(var)[3]) + + if (length(toberemoved) > 0) { + indices=indices[-toberemoved] + } + if (eno == TRUE) { + n_k <- Eno(var[,, indices], posdim = 3) + } else { + n_k <- length(indices) + } + if (length(indices) == 1) { + composite[,, k] <- var[,, indices] + warning(paste("Composite", k, "has length 1 and pvalue is NA.")) + } else { + composite[,,k] <- Mean1Dim(var[,, indices], posdim = 3, narm = TRUE) + } + stdv_k <- apply(var[,, indices], c(1, 2), sd, na.rm = TRUE) - tvalue[,] <- (mean_tot - composite[,,k])/sqrt(stdv_tot^2/n_tot + stdv_k^2/n_k) - dof[,] <- (stdv_tot^2/n_tot + stdv_k^2/n_k)^2/((stdv_tot^2/n_tot)^2/(n_tot - 1) + (stdv_k^2/n_k)^2/(n_k - 1)) - pvalue[,,k] <- 2*pt(-abs(tvalue[,]), df=dof[,]) + tvalue <- (mean_tot - composite[,, k]) / + sqrt(stdv_tot ^ 2 / n_tot + stdv_k ^ 2 / n_k) + dof <- (stdv_tot ^ 2 / n_tot + stdv_k ^ 2 / n_k) ^ 2 / + ((stdv_tot ^ 2 / n_tot) ^ 2 / (n_tot - 1) + + (stdv_k ^ 2 / n_k) ^ 2 / (n_k - 1)) + pvalue[,, k] <- 2 * pt(-abs(tvalue), df = dof) } - if ( is.null(fileout)==FALSE ) { - output <- list(composite=composite, pvalue=pvalue) - save(output,file=paste(fileout,'.sav',sep='')) + if ( is.null(fileout) == FALSE ) { + output <- list(composite = composite, pvalue = pvalue) + save(output, file = paste(fileout, '.sav', sep = '')) } invisible(list(composite = composite, pvalue = pvalue)) -- GitLab From a8dc27534b90664dde80ee6b2f00122d2b78b782 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 9 Jul 2019 17:14:02 +0200 Subject: [PATCH 2/4] Add unit test for Composite(); format adjustment for Composite(). --- DESCRIPTION | 6 ++++-- R/Composite.R | 26 ++++++++++++------------- tests/testthat.R | 4 ++++ tests/testthat/test-Composite.R | 34 +++++++++++++++++++++++++++++++++ 4 files changed, 55 insertions(+), 15 deletions(-) create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-Composite.R diff --git a/DESCRIPTION b/DESCRIPTION index f77ce597..6840cf5d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,7 +26,8 @@ Authors@R: c( person("Eleftheria", "Exarchou", , "eleftheria.exarchou@bsc.es", role = "ctb"), person("Ruben", "Cruz", , "ruben.cruzgarcia@bsc.es", role = "ctb"), person("Isabel", "Andreu-Burillo", , "isabel.andreu.burillo@ic3.cat", role = "ctb"), - person("Ramiro", "Saurral", , "ramiro.saurral@ic3.cat", role = "ctb")) + person("Ramiro", "Saurral", , "ramiro.saurral@ic3.cat", role = "ctb")), + person("An-Chi", "Ho", , "an.ho@bsc.es", role = "ctb")) Description: Set of tools to verify forecasts through the computation of typical prediction scores against one or more observational datasets or reanalyses (a reanalysis being a physical extrapolation of observations that relies on the equations from a model, not a pure observational dataset). Intended for seasonal to decadal climate forecasts although can be useful to verify other kinds of forecasts. The package can be helpful in climate sciences for other purposes than forecasting. Depends: maps, @@ -44,7 +45,8 @@ Imports: plyr, SpecsVerification (>= 0.5.0) Suggests: - easyVerification + easyVerification, + testthat License: LGPL-3 URL: https://earth.bsc.es/gitlab/es/s2dverification/wikis/home BugReports: https://earth.bsc.es/gitlab/es/s2dverification/issues diff --git a/R/Composite.R b/R/Composite.R index 09aa360d..c8294fd2 100644 --- a/R/Composite.R +++ b/R/Composite.R @@ -4,10 +4,10 @@ Composite <- function(var, occ, lag = 0, eno = FALSE, fileout = NULL) { stop("temporal dimension of var is not equal to length of occ.") } K <- max(occ) - composite <- array(dim = c(dim(var)[1 : 2], K)) - tvalue <- array(dim = dim(var)[1 : 2]) - dof <- array(dim = dim(var)[1 : 2]) - pvalue <- array(dim = c(dim(var)[1 : 2], K)) + composite <- array(dim = c(dim(var)[1:2], K)) + tvalue <- array(dim = dim(var)[1:2]) + dof <- array(dim = dim(var)[1:2]) + pvalue <- array(dim = c(dim(var)[1:2], K)) if (eno == TRUE) { n_tot <- Eno(var, posdim = 3) @@ -20,33 +20,33 @@ Composite <- function(var, occ, lag = 0, eno = FALSE, fileout = NULL) { for (k in 1 : K) { indices <- which(occ == k) + lag - toberemoved = which(0 > indices | indices > dim(var)[3]) + toberemoved <- which(0 > indices | indices > dim(var)[3]) if (length(toberemoved) > 0) { - indices=indices[-toberemoved] + indices <- indices[-toberemoved] } if (eno == TRUE) { - n_k <- Eno(var[,, indices], posdim = 3) + n_k <- Eno(var[, , indices], posdim = 3) } else { n_k <- length(indices) } if (length(indices) == 1) { - composite[,, k] <- var[,, indices] + composite[, , k] <- var[, , indices] warning(paste("Composite", k, "has length 1 and pvalue is NA.")) } else { - composite[,,k] <- Mean1Dim(var[,, indices], posdim = 3, narm = TRUE) + composite[, , k] <- Mean1Dim(var[, , indices], posdim = 3, narm = TRUE) } - stdv_k <- apply(var[,, indices], c(1, 2), sd, na.rm = TRUE) + stdv_k <- apply(var[, , indices], c(1, 2), sd, na.rm = TRUE) - tvalue <- (mean_tot - composite[,, k]) / + tvalue <- (mean_tot - composite[, , k]) / sqrt(stdv_tot ^ 2 / n_tot + stdv_k ^ 2 / n_k) dof <- (stdv_tot ^ 2 / n_tot + stdv_k ^ 2 / n_k) ^ 2 / ((stdv_tot ^ 2 / n_tot) ^ 2 / (n_tot - 1) + (stdv_k ^ 2 / n_k) ^ 2 / (n_k - 1)) - pvalue[,, k] <- 2 * pt(-abs(tvalue), df = dof) + pvalue[, , k] <- 2 * pt(-abs(tvalue), df = dof) } - if ( is.null(fileout) == FALSE ) { + if (is.null(fileout) == FALSE) { output <- list(composite = composite, pvalue = pvalue) save(output, file = paste(fileout, '.sav', sep = '')) } diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 00000000..19e87e1d --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(s2dverification) + +test_check("s2dverification") diff --git a/tests/testthat/test-Composite.R b/tests/testthat/test-Composite.R new file mode 100644 index 00000000..42c003a0 --- /dev/null +++ b/tests/testthat/test-Composite.R @@ -0,0 +1,34 @@ +context("Generic tests") +test_that("Sanity checks", { + + expect_error( + Composite(var = array(1:20, dim = c(2, 5, 2)), c(1, 1, 0)), + "temporal dimension of var is not equal to length of occ.") + + expect_warning( + Composite(var = array(1:40, dim = c(2, 5, 4)), c(1, 2, 2, 2)), + "Composite 1 has length 1 and pvalue is NA.") + + var <- array(rep(c(1, 3, 2, 1, 2), 8), dim = c(x = 2, y = 4, time = 5)) + occ <- c(1, 2, 2, 2, 1) + output <- c(x = 2, y = 4, 2) #dim(asd$composite) + expect_equal( + dim(Composite(var, occ)$composite), + output + ) + output <- c(1.5, 2.0, 2.5, 2.0) + expect_equal( + Composite(var, occ)$composite[1, , 1], + output + ) + + var <- array(rep(c(1, 3, 2, 1, 2), 8), dim = c(x = 2, y = 4, time = 5)) + occ <- c(1, 2, 2, 3, 3) + output <- array(as.numeric(rep(NA, 8)), dim = c(2, 4)) + expect_equal( + Composite(var, occ)$pvalue[, , 1], + output + ) + +}) + -- GitLab From 1f84fa28897912b9e847c981a43cd9d64c9f8ce8 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 9 Jul 2019 17:45:11 +0200 Subject: [PATCH 3/4] syntax error fixed. --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6840cf5d..99c08ff6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,7 +26,7 @@ Authors@R: c( person("Eleftheria", "Exarchou", , "eleftheria.exarchou@bsc.es", role = "ctb"), person("Ruben", "Cruz", , "ruben.cruzgarcia@bsc.es", role = "ctb"), person("Isabel", "Andreu-Burillo", , "isabel.andreu.burillo@ic3.cat", role = "ctb"), - person("Ramiro", "Saurral", , "ramiro.saurral@ic3.cat", role = "ctb")), + person("Ramiro", "Saurral", , "ramiro.saurral@ic3.cat", role = "ctb"), person("An-Chi", "Ho", , "an.ho@bsc.es", role = "ctb")) Description: Set of tools to verify forecasts through the computation of typical prediction scores against one or more observational datasets or reanalyses (a reanalysis being a physical extrapolation of observations that relies on the equations from a model, not a pure observational dataset). Intended for seasonal to decadal climate forecasts although can be useful to verify other kinds of forecasts. The package can be helpful in climate sciences for other purposes than forecasting. Depends: -- GitLab From 0347191acd483646e5f66515a77b4c9237e1b32b Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 9 Jul 2019 17:53:54 +0200 Subject: [PATCH 4/4] add .gitlab-ci.yml --- .gitlab-ci.yml | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 .gitlab-ci.yml diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml new file mode 100644 index 00000000..b1cf9976 --- /dev/null +++ b/.gitlab-ci.yml @@ -0,0 +1,10 @@ +stages: + - build +build: + stage: build + script: + - module load R +# - module load CDO + - R CMD build --resave-data . + - R CMD check --as-cran --no-manual --run-donttest s2dverification_*.tar.gz + - R -e 'covr::package_coverage()' -- GitLab