From 91344a9cd01d7fc00e9d55c10388f26bf2ea56c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ver=C3=B3nica=20Torralba-Fern=C3=A1ndez?= Date: Wed, 6 Feb 2019 10:35:13 +0100 Subject: [PATCH 01/11] add simple bias correction function --- R/BiasCorrection.R | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 R/BiasCorrection.R diff --git a/R/BiasCorrection.R b/R/BiasCorrection.R new file mode 100644 index 00000000..2f409803 --- /dev/null +++ b/R/BiasCorrection.R @@ -0,0 +1,35 @@ +BiasCorrection <- function(var_obs, var_exp) { + # Simple bias correction as in Torralba et al. 2017 + # Journal of Applied Meteorology and Climatology + + ntime <- length(var_obs) + if (dim(var_exp)[1]!=dim(var_exp)[2]){ + nmembers <- dim(var_exp)[-which(dim(var_exp) == length(var_obs))] + }else{ + nmembers<-dim(var_exp)[1] + } + + if (!all(dim(var_exp)== c(nmembers, ntime))) { + var_exp <- t(var_exp) + } + + corrected <- NA * var_exp + + for (t in 1:ntime) { + # defining forecast,hindcast and observation in cross-validation + fcst <- var_exp[, t] + hcst <- var_exp[,-t] + obs <- var_obs[-t] + + # parameters + sd_obs <- sd(obs) + sd_exp <- sd(hcst) + clim_exp <- mean(hcst) + clim_obs <- mean(obs) + + # bias corrected forecast + corrected[, t] <- ((fcst - clim_exp) * (sd_obs / sd_exp)) + clim_obs + } + + return(corrected) +} -- GitLab From 0683657ec793efbc55e95e3f2be964ccf50e9f80 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ver=C3=B3nica=20Torralba-Fern=C3=A1ndez?= Date: Thu, 7 Mar 2019 12:31:04 +0100 Subject: [PATCH 02/11] changes in the code to have a similar format to Calibration --- R/BiasCorrection.R | 66 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 63 insertions(+), 3 deletions(-) diff --git a/R/BiasCorrection.R b/R/BiasCorrection.R index 2f409803..458751eb 100644 --- a/R/BiasCorrection.R +++ b/R/BiasCorrection.R @@ -1,7 +1,67 @@ -BiasCorrection <- function(var_obs, var_exp) { - # Simple bias correction as in Torralba et al. 2017 - # Journal of Applied Meteorology and Climatology +#' Bias Correction based on the mean and standard deviation adjustment following Torralba et al. (2017) +#' +#'@author Verónica Torralba, \email{veronica.torralba@bsc.es} +#'@description This function applies the simple bias adjustment technique described in Torralba et al. (2017). The adjusted forecasts have an equivalent standard deviation and mean to that of the reference dataset. +#'#'@param data a list of s2dverification objects (lists) as output by the \code{Load} function from the s2dverification package. +#' +#'@return \code{$biasCorrected} {An array with the bias corrected forecasts with the dimensions of data$mod.} +#' +#'@import s2dverification +#'@examples +#' +#'# Example +#'# Creation of sample s2dverification objects. These are not complete +#'# s2dverification objects though. The Load function returns complete objects. +#'mod1 <- 1 : (1 * 3 * 4 * 5 * 6 * 7) +#'dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7) +#'obs1 <- 1 : (1 * 1 * 4 * 5 * 6 * 7) +#'dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, ftime = 5, lat = 6, lon = 7) +#'lon <- seq(0, 30, 5) +#'lat <- seq(0, 25, 5) +#'data1 <- list(mod = mod1, obs = obs1, lat = lat, lon = lon) +#'a <- BiasCorrection(data1) +#'str(a) +#'@export + + +BiasCorrection <- function(data) { + is_s2dv_object <- function(x) { + if (all(c('mod', 'obs', 'lon', 'lat') %in% names(x))) { #&& length(x) == 11) { + TRUE + } else { + FALSE + } + } + wrong_input <- FALSE + if (!is.list(data)) { + wrong_input <- TRUE + } + + if (!is_s2dv_object(data)) { + wrong_input <- TRUE + } + if (wrong_input) { + stop("Parameter 'data' must be a list of s2dverification objects as returned by ", + "the s2dverification::Load function.") + } + if (length(which(is.na(data$mod))) > 0) { + warning('There are NA in data$mod') + } + + if (length(which(is.na(data$obs))) > 0) { + warning('There are NA in data$obs') + } + + biasAdjusted <- Apply(data = list(var_obs = data$obs, var_exp = data$mod), + target_dims = list(c('member', 'sdate'), c('member', 'sdate')), + fun = '.sbc') + BiasCorrected <- aperm(biasAdjusted$output1, c(3, 1, 2, 4, 5, 6)) + names(dim(BiasCorrected)) <- names(dim(data$mod)) + return(list(biasCorrected = BiasCorrected)) +} + +.sbc <- function(var_obs, var_exp) { ntime <- length(var_obs) if (dim(var_exp)[1]!=dim(var_exp)[2]){ nmembers <- dim(var_exp)[-which(dim(var_exp) == length(var_obs))] -- GitLab From fdf1e178df0526e4adafa90b98cd0903c29f1a02 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ver=C3=B3nica=20Torralba-Fern=C3=A1ndez?= Date: Thu, 7 Mar 2019 17:06:16 +0100 Subject: [PATCH 03/11] documentation --- man/BiasCorrection.Rd | 148 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 148 insertions(+) create mode 100644 man/BiasCorrection.Rd diff --git a/man/BiasCorrection.Rd b/man/BiasCorrection.Rd new file mode 100644 index 00000000..56c37a36 --- /dev/null +++ b/man/BiasCorrection.Rd @@ -0,0 +1,148 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Calibration.R +\name{BiasCorrection} +\alias{BiasCorrection} +\title{Bias Correction based on the mean and standard deviation adjustment following Torralba et al. (2017) } +\usage{ +BiasCorrection(data) +} +\arguments{ +\item{data}{a list of s2dverification objects (lists) as output by the \code{Load} function from the s2dverification package, one for each variable.} + +\value{ +\code{$biasCorrected} {An array with the bias corrected forecasts with same dimensions that data$mod} +} +\description{ +This function applies the simple bias adjustment technique described in Torralba et al. (2017). The adjusted forecasts have an equivalent standard deviation and mean to that of the reference dataset. +} +\examples{ +# Creation of sample s2dverification objects. These are not complete +# s2dverification objects though. The Load function returns complete objects. +# Example +mod1 <- 1 : (1 * 3 * 4 * 5 * 6 * 7) +dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7) +obs1 <- 1 : (1 * 1 * 4 * 5 * 6 * 7) +dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, ftime = 5, lat = 6, lon = 7) +lon <- seq(0, 30, 5) +lat <- seq(0, 25, 5) +data1 <- list(mod = mod1, obs = obs1, lat = lat, lon = lon) +a <- BiasCorrection(data1) +str(a) +dim(mod1) <- + c( + dataset = 1, + member = 3, + sdate = 4, + ftime = 5, + lat = 6, + lon = 7 + ) +dim(obs1) <- + c( + dataset = 1, + member = 1, + sdate = 4, + ftime = 5, + lat = 6, + lon = 7 + ) +lon <- seq(0, 30, 5) +lat <- seq(0, 25, 5) + +data1 <- list( + mod = mod1, + obs = obs1, + lat = lat, + lon = lon +) +a1 <- BiasCorrection(data1) + +mod2 <- mod1 +mod2[1, 2, 1, 1, 1, 1] <- NA +data2 <- list( + mod = mod2, + obs = obs1, + lat = lat, + lon = lon +) +a2 <- BiasCorrection(data2) + +obs2 <- obs1 +obs2[1, 1, 2, 1, 1, 1] <- NA +data3 <- list( + mod = mod1, + obs = obs2, + lat = lat, + lon = lon +) +a3 <- BiasCorrection(data3) + +data4 <- list( + mod = mod2, + obs = obs2, + lat = lat, + lon = lon +) +a4 <- BiasCorrection(data4) + +lat2 <- lat +lat2[3] <- NA +data5 <- list( + mod = mod1, + obs = obs1, + lat = lat2, + lon = lon +) +a5 <- BiasCorrection(data5) + +lon2 <- lon +lon2[5] <- NA +data6 <- list( + mod = mod1, + obs = obs1, + lat = lat, + lon = lon2 +) +a6 <- BiasCorrection(data6) + +data7 <- list( + mod = mod1, + obs = obs1, + lat = lat2, + lon = lon2 +) +a7 <- BiasCorrection(data7) + +data8 <- list( + mod = mod1, + obs = obs2, + lat = lat2, + lon = lon2 +) +a8 <- BiasCorrection(data8) + +data9 <- list( + mod = mod2, + obs = obs1, + lat = lat2, + lon = lon2 +) +a9 <- BiasCorrection(data9) + +data10 <- list( + mod = mod2, + obs = obs2, + lat = lat2, + lon = lon2 +) +a10 <- BiasCorrection(data10) +} +\references{ + +Torralba, V., Doblas-Reyes, F. J., MacLeod, D., Christel, I., & Davis, M. (2017). Seasonal climate prediction: A new source of information for the management of wind energy resources. Journal of Applied Meteorology and Climatology, 56(5), 1231-1247. + +} +\author{ +Verónica Torralba, \email{veronica.torralba@bsc.es} +} + -- GitLab From 804e1c3e6fa8f80d2fc57959457b00198275e1c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ver=C3=B3nica=20Torralba-Fern=C3=A1ndez?= Date: Mon, 11 Mar 2019 12:10:23 +0100 Subject: [PATCH 04/11] add a check for the dimensions of data and data --- R/BiasCorrection.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/R/BiasCorrection.R b/R/BiasCorrection.R index 458751eb..9567cdca 100644 --- a/R/BiasCorrection.R +++ b/R/BiasCorrection.R @@ -40,6 +40,15 @@ BiasCorrection <- function(data) { if (!is_s2dv_object(data)) { wrong_input <- TRUE } + + if (length(dim(data$obs)) != 6) { + stop('data$obs must have six dimensions') + } + + if (length(dim(data$mod)) != 6) { + stop('data$mod must have six dimensions') + } + if (wrong_input) { stop("Parameter 'data' must be a list of s2dverification objects as returned by ", "the s2dverification::Load function.") -- GitLab From 1acaf189aa393bf70d4ed8bca61e7b5834927192 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ver=C3=B3nica=20Torralba-Fern=C3=A1ndez?= Date: Tue, 12 Mar 2019 12:56:49 +0100 Subject: [PATCH 05/11] Changes in the function to create CST_BiasCorrection --- R/{BiasCorrection.R => CST_BiasCorrection.R} | 65 ++++++++++++-------- 1 file changed, 39 insertions(+), 26 deletions(-) rename R/{BiasCorrection.R => CST_BiasCorrection.R} (58%) diff --git a/R/BiasCorrection.R b/R/CST_BiasCorrection.R similarity index 58% rename from R/BiasCorrection.R rename to R/CST_BiasCorrection.R index 9567cdca..886262bd 100644 --- a/R/BiasCorrection.R +++ b/R/CST_BiasCorrection.R @@ -1,10 +1,11 @@ -#' Bias Correction based on the mean and standard deviation adjustment following Torralba et al. (2017) +#' Bias Correction of a CSTools object based on the mean and standard deviation adjustment following Torralba et al. (2017) #' #'@author Verónica Torralba, \email{veronica.torralba@bsc.es} #'@description This function applies the simple bias adjustment technique described in Torralba et al. (2017). The adjusted forecasts have an equivalent standard deviation and mean to that of the reference dataset. -#'#'@param data a list of s2dverification objects (lists) as output by the \code{Load} function from the s2dverification package. #' -#'@return \code{$biasCorrected} {An array with the bias corrected forecasts with the dimensions of data$mod.} +#'@param a CSTools object (an s2dverification object as output by the \code{Load} function from the s2dverification package). +#' +#'@return a CSTools object (s2dverification object) with the bias corrected forecasts (provided in $mod) with the same dimensions as data$mod. #' #'@import s2dverification #'@examples @@ -19,12 +20,12 @@ #'lon <- seq(0, 30, 5) #'lat <- seq(0, 25, 5) #'data1 <- list(mod = mod1, obs = obs1, lat = lat, lon = lon) -#'a <- BiasCorrection(data1) +#'a <- CST_BiasCorrection(data1) #'str(a) #'@export -BiasCorrection <- function(data) { +CST_BiasCorrection <- function(data) { is_s2dv_object <- function(x) { if (all(c('mod', 'obs', 'lon', 'lat') %in% names(x))) { #&& length(x) == 11) { TRUE @@ -41,33 +42,45 @@ BiasCorrection <- function(data) { wrong_input <- TRUE } - if (length(dim(data$obs)) != 6) { - stop('data$obs must have six dimensions') +if (wrong_input) { + stop("Parameter 'data' must be a list of s2dverification objects as returned by ", + "the s2dverification::Load function.") } - - if (length(dim(data$mod)) != 6) { - stop('data$mod must have six dimensions') + + BiasCorrected <- BiasCorrection(data$mod, data$obs) + BiasCorrected <- aperm(BiasCorrected, c(3, 1, 2, 4, 5, 6)) + data$mod <- BiasCorrected + data$obs <- NULL + return(data) +} + +BiasCorrection <- function (exp,obs) { + + if (!all(c('member', 'sdate') %in% names(dim(exp)))) { + stop("Parameter 'exp' must have the dimensions 'member' and 'sdate'.") } - if (wrong_input) { - stop("Parameter 'data' must be a list of s2dverification objects as returned by ", - "the s2dverification::Load function.") + if (!all(c('sdate') %in% names(dim(obs)))) { + stop("Parameter 'obs' must have the dimension 'sdate'.") } - - if (length(which(is.na(data$mod))) > 0) { - warning('There are NA in data$mod') + + if (length(which(is.na(exp))) > 0) { + warning('There are NA in exp.') } - if (length(which(is.na(data$obs))) > 0) { - warning('There are NA in data$obs') + if (length(which(is.na(obs))) > 0) { + warning('There are NA in obs.') } - - biasAdjusted <- Apply(data = list(var_obs = data$obs, var_exp = data$mod), - target_dims = list(c('member', 'sdate'), c('member', 'sdate')), - fun = '.sbc') - BiasCorrected <- aperm(biasAdjusted$output1, c(3, 1, 2, 4, 5, 6)) - names(dim(BiasCorrected)) <- names(dim(data$mod)) - return(list(biasCorrected = BiasCorrected)) + + target_dims_obs <- 'sdate' + if ('member' %in% names(dim(obs))) { + target_dims_obs <- c('member', target_dims_obs) + } + + BiasCorrected <- Apply(data = list(var_obs = obs, var_exp = exp), + target_dims = list(target_dims_obs, c('member', 'sdate')), + fun = '.sbc')$output1 + return(BiasCorrected) } .sbc <- function(var_obs, var_exp) { @@ -99,6 +112,6 @@ BiasCorrection <- function(data) { # bias corrected forecast corrected[, t] <- ((fcst - clim_exp) * (sd_obs / sd_exp)) + clim_obs } - + names(dim(corrected)) <- c('member', 'sdate') return(corrected) } -- GitLab From a19313117b1f7a7b42efe8946c64fb67aeffd395 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ver=C3=B3nica=20Torralba-Fern=C3=A1ndez?= Date: Tue, 12 Mar 2019 13:11:28 +0100 Subject: [PATCH 06/11] updated documentation --- ...BiasCorrection.Rd => CST_BiasCorrection.R} | 36 +++++++++---------- 1 file changed, 18 insertions(+), 18 deletions(-) rename man/{BiasCorrection.Rd => CST_BiasCorrection.R} (71%) diff --git a/man/BiasCorrection.Rd b/man/CST_BiasCorrection.R similarity index 71% rename from man/BiasCorrection.Rd rename to man/CST_BiasCorrection.R index 56c37a36..6f7160ba 100644 --- a/man/BiasCorrection.Rd +++ b/man/CST_BiasCorrection.R @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Calibration.R -\name{BiasCorrection} -\alias{BiasCorrection} -\title{Bias Correction based on the mean and standard deviation adjustment following Torralba et al. (2017) } +% Please edit documentation in R/CST_BiasCorrection.R +\name{CST_BiasCorrection} +\alias{CST_BiasCorrection} +\title{Bias Correction of a CSTools object based on the mean and standard deviation adjustment following Torralba et al. (2017) } \usage{ -BiasCorrection(data) +CST_BiasCorrection(data) } \arguments{ -\item{data}{a list of s2dverification objects (lists) as output by the \code{Load} function from the s2dverification package, one for each variable.} +\item{data}{a CSTools object (an s2dverification object as output by the \code{Load} function from the s2dverification package).} \value{ -\code{$biasCorrected} {An array with the bias corrected forecasts with same dimensions that data$mod} +\code{$mod} {a CSTools object (s2dverification object) with the bias corrected forecasts (provided in $mod) with the same dimensions as data$mod.} } \description{ This function applies the simple bias adjustment technique described in Torralba et al. (2017). The adjusted forecasts have an equivalent standard deviation and mean to that of the reference dataset. @@ -26,7 +26,7 @@ dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, ftime = 5, lat = 6, lon = 7) lon <- seq(0, 30, 5) lat <- seq(0, 25, 5) data1 <- list(mod = mod1, obs = obs1, lat = lat, lon = lon) -a <- BiasCorrection(data1) +a <- CST_BiasCorrection(data1) str(a) dim(mod1) <- c( @@ -55,7 +55,7 @@ data1 <- list( lat = lat, lon = lon ) -a1 <- BiasCorrection(data1) +a1 <- CST_BiasCorrection(data1) mod2 <- mod1 mod2[1, 2, 1, 1, 1, 1] <- NA @@ -65,7 +65,7 @@ data2 <- list( lat = lat, lon = lon ) -a2 <- BiasCorrection(data2) +a2 <- CST_BiasCorrection(data2) obs2 <- obs1 obs2[1, 1, 2, 1, 1, 1] <- NA @@ -75,7 +75,7 @@ data3 <- list( lat = lat, lon = lon ) -a3 <- BiasCorrection(data3) +a3 <- CST_BiasCorrection(data3) data4 <- list( mod = mod2, @@ -83,7 +83,7 @@ data4 <- list( lat = lat, lon = lon ) -a4 <- BiasCorrection(data4) +a4 <- CST_BiasCorrection(data4) lat2 <- lat lat2[3] <- NA @@ -93,7 +93,7 @@ data5 <- list( lat = lat2, lon = lon ) -a5 <- BiasCorrection(data5) +a5 <- CST_BiasCorrection(data5) lon2 <- lon lon2[5] <- NA @@ -103,7 +103,7 @@ data6 <- list( lat = lat, lon = lon2 ) -a6 <- BiasCorrection(data6) +a6 <- CST_BiasCorrection(data6) data7 <- list( mod = mod1, @@ -111,7 +111,7 @@ data7 <- list( lat = lat2, lon = lon2 ) -a7 <- BiasCorrection(data7) +a7 <- CST_BiasCorrection(data7) data8 <- list( mod = mod1, @@ -119,7 +119,7 @@ data8 <- list( lat = lat2, lon = lon2 ) -a8 <- BiasCorrection(data8) +a8 <- CST_BiasCorrection(data8) data9 <- list( mod = mod2, @@ -127,7 +127,7 @@ data9 <- list( lat = lat2, lon = lon2 ) -a9 <- BiasCorrection(data9) +a9 <- CST_BiasCorrection(data9) data10 <- list( mod = mod2, @@ -135,7 +135,7 @@ data10 <- list( lat = lat2, lon = lon2 ) -a10 <- BiasCorrection(data10) +a10 <- CST_BiasCorrection(data10) } \references{ -- GitLab From 6b7b9f37d1850920f6fcadce6dbe4afdb55ddcaf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ver=C3=B3nica=20Torralba-Fern=C3=A1ndez?= Date: Wed, 13 Mar 2019 18:02:28 +0100 Subject: [PATCH 07/11] changes to be consistent with Calibration --- R/CST_BiasCorrection.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/CST_BiasCorrection.R b/R/CST_BiasCorrection.R index 886262bd..feac36c2 100644 --- a/R/CST_BiasCorrection.R +++ b/R/CST_BiasCorrection.R @@ -8,6 +8,7 @@ #'@return a CSTools object (s2dverification object) with the bias corrected forecasts (provided in $mod) with the same dimensions as data$mod. #' #'@import s2dverification +#'@import multiApply #'@examples #' #'# Example @@ -43,10 +44,14 @@ CST_BiasCorrection <- function(data) { } if (wrong_input) { - stop("Parameter 'data' must be a list of s2dverification objects as returned by ", + stop("Parameter 'data' must be an object of s2dverification objects as returned by ", "the s2dverification::Load function.") } + if (dim(data$obs)[which(names(dim(data$obs))=='member')]!=1) { + stop("The length of the dimension 'member' in 'data$obs must be equal to 1") + } + BiasCorrected <- BiasCorrection(data$mod, data$obs) BiasCorrected <- aperm(BiasCorrected, c(3, 1, 2, 4, 5, 6)) data$mod <- BiasCorrected @@ -64,11 +69,11 @@ BiasCorrection <- function (exp,obs) { stop("Parameter 'obs' must have the dimension 'sdate'.") } - if (length(which(is.na(exp))) > 0) { + if (any(is.na(exp))) { warning('There are NA in exp.') } - if (length(which(is.na(obs))) > 0) { + if (any(is.na(obs))) { warning('There are NA in obs.') } @@ -84,14 +89,9 @@ BiasCorrection <- function (exp,obs) { } .sbc <- function(var_obs, var_exp) { - ntime <- length(var_obs) - if (dim(var_exp)[1]!=dim(var_exp)[2]){ - nmembers <- dim(var_exp)[-which(dim(var_exp) == length(var_obs))] - }else{ - nmembers<-dim(var_exp)[1] - } - - if (!all(dim(var_exp)== c(nmembers, ntime))) { + nmembers<-dim(var_exp)[which(names(dim(var_exp))=='member')][] + + if (all(names(dim(var_exp))!=c('member','sdate'))) { var_exp <- t(var_exp) } -- GitLab From 427540e6e53958cb94557614d76387f04882b8e1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ver=C3=B3nica=20Torralba-Fern=C3=A1ndez?= Date: Wed, 13 Mar 2019 18:35:25 +0100 Subject: [PATCH 08/11] minor change --- R/CST_BiasCorrection.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/CST_BiasCorrection.R b/R/CST_BiasCorrection.R index feac36c2..fee8aaa6 100644 --- a/R/CST_BiasCorrection.R +++ b/R/CST_BiasCorrection.R @@ -90,7 +90,7 @@ BiasCorrection <- function (exp,obs) { .sbc <- function(var_obs, var_exp) { nmembers<-dim(var_exp)[which(names(dim(var_exp))=='member')][] - + ntime<-dim(var_exp)[which(names(dim(var_exp))=='sdate')][] if (all(names(dim(var_exp))!=c('member','sdate'))) { var_exp <- t(var_exp) } -- GitLab From b42fb6b22413d8e18251cc83992641f36286148e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ver=C3=B3nica=20Torralba-Fern=C3=A1ndez?= Date: Mon, 18 Mar 2019 13:35:20 +0100 Subject: [PATCH 09/11] change extension in documentation file --- man/{CST_BiasCorrection.R => CST_BiasCorrection.Rd} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename man/{CST_BiasCorrection.R => CST_BiasCorrection.Rd} (100%) diff --git a/man/CST_BiasCorrection.R b/man/CST_BiasCorrection.Rd similarity index 100% rename from man/CST_BiasCorrection.R rename to man/CST_BiasCorrection.Rd -- GitLab From e5f321b3707dfb2423175065a014fd2c9db8bbbd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ver=C3=B3nica=20Torralba-Fern=C3=A1ndez?= Date: Mon, 18 Mar 2019 13:41:42 +0100 Subject: [PATCH 10/11] minor style change --- R/CST_BiasCorrection.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/CST_BiasCorrection.R b/R/CST_BiasCorrection.R index fee8aaa6..4771ff3b 100644 --- a/R/CST_BiasCorrection.R +++ b/R/CST_BiasCorrection.R @@ -48,7 +48,7 @@ if (wrong_input) { "the s2dverification::Load function.") } - if (dim(data$obs)[which(names(dim(data$obs))=='member')]!=1) { + if (dim(data$obs)['member']!=1) { stop("The length of the dimension 'member' in 'data$obs must be equal to 1") } @@ -89,8 +89,8 @@ BiasCorrection <- function (exp,obs) { } .sbc <- function(var_obs, var_exp) { - nmembers<-dim(var_exp)[which(names(dim(var_exp))=='member')][] - ntime<-dim(var_exp)[which(names(dim(var_exp))=='sdate')][] + nmembers<-dim(var_exp)['member'][] + ntime<-dim(var_exp)['sdate')][] if (all(names(dim(var_exp))!=c('member','sdate'))) { var_exp <- t(var_exp) } -- GitLab From fd69e686d095194590535f18e8730832252420c5 Mon Sep 17 00:00:00 2001 From: nperez Date: Mon, 18 Mar 2019 15:31:04 +0100 Subject: [PATCH 11/11] @reference, dimension names and tests added --- DESCRIPTION | 3 +- NAMESPACE | 2 + R/CST_BiasCorrection.R | 42 ++++---- man/CST_BiasCorrection.Rd | 124 ++--------------------- tests/testthat/test-CST_BiasCorrection.R | 44 ++++++++ 5 files changed, 78 insertions(+), 137 deletions(-) create mode 100644 tests/testthat/test-CST_BiasCorrection.R diff --git a/DESCRIPTION b/DESCRIPTION index 30906c49..913db20c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,8 @@ Depends: Imports: s2dverification, abind, - stats + stats, + multiApply Suggests: testthat License: Apache License 2.0 | file LICENSE diff --git a/NAMESPACE b/NAMESPACE index 9944b29d..19d840b6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,8 @@ # Generated by roxygen2: do not edit by hand +export(CST_BiasCorrection) export(CST_MultiMetric) export(CST_MultivarRMSE) +import(multiApply) import(s2dverification) import(stats) diff --git a/R/CST_BiasCorrection.R b/R/CST_BiasCorrection.R index 4771ff3b..3dfb18ac 100644 --- a/R/CST_BiasCorrection.R +++ b/R/CST_BiasCorrection.R @@ -1,12 +1,14 @@ -#' Bias Correction of a CSTools object based on the mean and standard deviation adjustment following Torralba et al. (2017) +#' Bias Correction based on the mean and standard deviation adjustment #' #'@author Verónica Torralba, \email{veronica.torralba@bsc.es} #'@description This function applies the simple bias adjustment technique described in Torralba et al. (2017). The adjusted forecasts have an equivalent standard deviation and mean to that of the reference dataset. #' -#'@param a CSTools object (an s2dverification object as output by the \code{Load} function from the s2dverification package). +#'@param data CSTools object (an s2dverification object as output by the \code{Load} function from the s2dverification package). #' #'@return a CSTools object (s2dverification object) with the bias corrected forecasts (provided in $mod) with the same dimensions as data$mod. #' +#'@references Torralba, V., F.J. Doblas-Reyes, D. MacLeod, I. Christel and M. Davis (2017). Seasonal climate prediction: a new source of information for the management of wind energy resources. Journal of Applied Meteorology and Climatology, 56, 1231-1247, doi:10.1175/JAMC-D-16-0204.1. (CLIM4ENERGY, EUPORIAS, NEWA, RESILIENCE, SPECS) +#' #'@import s2dverification #'@import multiApply #'@examples @@ -24,8 +26,6 @@ #'a <- CST_BiasCorrection(data1) #'str(a) #'@export - - CST_BiasCorrection <- function(data) { is_s2dv_object <- function(x) { if (all(c('mod', 'obs', 'lon', 'lat') %in% names(x))) { #&& length(x) == 11) { @@ -44,22 +44,26 @@ CST_BiasCorrection <- function(data) { } if (wrong_input) { - stop("Parameter 'data' must be an object of s2dverification objects as returned by ", - "the s2dverification::Load function.") + stop("Parameter 'data' must be a list as output of Load function + from s2dverification package") } if (dim(data$obs)['member']!=1) { - stop("The length of the dimension 'member' in 'data$obs must be equal to 1") + stop("The length of the dimension 'member' in label 'obs' of parameter 'data' must be equal to 1.") } BiasCorrected <- BiasCorrection(data$mod, data$obs) + dimnames <- names(dim(BiasCorrected)) BiasCorrected <- aperm(BiasCorrected, c(3, 1, 2, 4, 5, 6)) - data$mod <- BiasCorrected + names(dim(BiasCorrected)) <- dimnames[c(3, 1, 2, 4, 5, 6)] + data$biascorrection <- BiasCorrected data$obs <- NULL + data$mod <- NULL + data <- data[c("biascorrection", names(data)[-which(names(data) == "biascorrection")])] return(data) } -BiasCorrection <- function (exp,obs) { +BiasCorrection <- function (exp, obs) { if (!all(c('member', 'sdate') %in% names(dim(exp)))) { stop("Parameter 'exp' must have the dimensions 'member' and 'sdate'.") @@ -70,11 +74,11 @@ BiasCorrection <- function (exp,obs) { } if (any(is.na(exp))) { - warning('There are NA in exp.') + warning("Parameter 'exp' contains NA values.") } if (any(is.na(obs))) { - warning('There are NA in obs.') + warning("Parameter 'obs' contains NA values.") } target_dims_obs <- 'sdate' @@ -84,23 +88,23 @@ BiasCorrection <- function (exp,obs) { BiasCorrected <- Apply(data = list(var_obs = obs, var_exp = exp), target_dims = list(target_dims_obs, c('member', 'sdate')), - fun = '.sbc')$output1 + fun = .sbc)$output1 return(BiasCorrected) } .sbc <- function(var_obs, var_exp) { - nmembers<-dim(var_exp)['member'][] - ntime<-dim(var_exp)['sdate')][] - if (all(names(dim(var_exp))!=c('member','sdate'))) { + nmembers <- dim(var_exp)['member'][] + ntime <- dim(var_exp)['sdate'][] + if (all(names(dim(var_exp)) != c('member','sdate'))) { var_exp <- t(var_exp) } corrected <- NA * var_exp - for (t in 1:ntime) { + for (t in 1 : ntime) { # defining forecast,hindcast and observation in cross-validation - fcst <- var_exp[, t] - hcst <- var_exp[,-t] + fcst <- var_exp[ , t] + hcst <- var_exp[ , -t] obs <- var_obs[-t] # parameters @@ -110,7 +114,7 @@ BiasCorrection <- function (exp,obs) { clim_obs <- mean(obs) # bias corrected forecast - corrected[, t] <- ((fcst - clim_exp) * (sd_obs / sd_exp)) + clim_obs + corrected[ , t] <- ((fcst - clim_exp) * (sd_obs / sd_exp)) + clim_obs } names(dim(corrected)) <- c('member', 'sdate') return(corrected) diff --git a/man/CST_BiasCorrection.Rd b/man/CST_BiasCorrection.Rd index 6f7160ba..d187ba12 100644 --- a/man/CST_BiasCorrection.Rd +++ b/man/CST_BiasCorrection.Rd @@ -2,23 +2,24 @@ % Please edit documentation in R/CST_BiasCorrection.R \name{CST_BiasCorrection} \alias{CST_BiasCorrection} -\title{Bias Correction of a CSTools object based on the mean and standard deviation adjustment following Torralba et al. (2017) } +\title{Bias Correction based on the mean and standard deviation adjustment} \usage{ CST_BiasCorrection(data) } \arguments{ -\item{data}{a CSTools object (an s2dverification object as output by the \code{Load} function from the s2dverification package).} - +\item{data}{CSTools object (an s2dverification object as output by the \code{Load} function from the s2dverification package).} +} \value{ -\code{$mod} {a CSTools object (s2dverification object) with the bias corrected forecasts (provided in $mod) with the same dimensions as data$mod.} +a CSTools object (s2dverification object) with the bias corrected forecasts (provided in $mod) with the same dimensions as data$mod. } \description{ This function applies the simple bias adjustment technique described in Torralba et al. (2017). The adjusted forecasts have an equivalent standard deviation and mean to that of the reference dataset. } \examples{ + +# Example # Creation of sample s2dverification objects. These are not complete # s2dverification objects though. The Load function returns complete objects. -# Example mod1 <- 1 : (1 * 3 * 4 * 5 * 6 * 7) dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7) obs1 <- 1 : (1 * 1 * 4 * 5 * 6 * 7) @@ -28,121 +29,10 @@ lat <- seq(0, 25, 5) data1 <- list(mod = mod1, obs = obs1, lat = lat, lon = lon) a <- CST_BiasCorrection(data1) str(a) -dim(mod1) <- - c( - dataset = 1, - member = 3, - sdate = 4, - ftime = 5, - lat = 6, - lon = 7 - ) -dim(obs1) <- - c( - dataset = 1, - member = 1, - sdate = 4, - ftime = 5, - lat = 6, - lon = 7 - ) -lon <- seq(0, 30, 5) -lat <- seq(0, 25, 5) - -data1 <- list( - mod = mod1, - obs = obs1, - lat = lat, - lon = lon -) -a1 <- CST_BiasCorrection(data1) - -mod2 <- mod1 -mod2[1, 2, 1, 1, 1, 1] <- NA -data2 <- list( - mod = mod2, - obs = obs1, - lat = lat, - lon = lon -) -a2 <- CST_BiasCorrection(data2) - -obs2 <- obs1 -obs2[1, 1, 2, 1, 1, 1] <- NA -data3 <- list( - mod = mod1, - obs = obs2, - lat = lat, - lon = lon -) -a3 <- CST_BiasCorrection(data3) - -data4 <- list( - mod = mod2, - obs = obs2, - lat = lat, - lon = lon -) -a4 <- CST_BiasCorrection(data4) - -lat2 <- lat -lat2[3] <- NA -data5 <- list( - mod = mod1, - obs = obs1, - lat = lat2, - lon = lon -) -a5 <- CST_BiasCorrection(data5) - -lon2 <- lon -lon2[5] <- NA -data6 <- list( - mod = mod1, - obs = obs1, - lat = lat, - lon = lon2 -) -a6 <- CST_BiasCorrection(data6) - -data7 <- list( - mod = mod1, - obs = obs1, - lat = lat2, - lon = lon2 -) -a7 <- CST_BiasCorrection(data7) - -data8 <- list( - mod = mod1, - obs = obs2, - lat = lat2, - lon = lon2 -) -a8 <- CST_BiasCorrection(data8) - -data9 <- list( - mod = mod2, - obs = obs1, - lat = lat2, - lon = lon2 -) -a9 <- CST_BiasCorrection(data9) - -data10 <- list( - mod = mod2, - obs = obs2, - lat = lat2, - lon = lon2 -) -a10 <- CST_BiasCorrection(data10) } \references{ - -Torralba, V., Doblas-Reyes, F. J., MacLeod, D., Christel, I., & Davis, M. (2017). Seasonal climate prediction: A new source of information for the management of wind energy resources. Journal of Applied Meteorology and Climatology, 56(5), 1231-1247. - +Torralba, V., F.J. Doblas-Reyes, D. MacLeod, I. Christel and M. Davis (2017). Seasonal climate prediction: a new source of information for the management of wind energy resources. Journal of Applied Meteorology and Climatology, 56, 1231-1247, doi:10.1175/JAMC-D-16-0204.1. (CLIM4ENERGY, EUPORIAS, NEWA, RESILIENCE, SPECS) } \author{ Verónica Torralba, \email{veronica.torralba@bsc.es} } - diff --git a/tests/testthat/test-CST_BiasCorrection.R b/tests/testthat/test-CST_BiasCorrection.R new file mode 100644 index 00000000..acc7425d --- /dev/null +++ b/tests/testthat/test-CST_BiasCorrection.R @@ -0,0 +1,44 @@ +context("Generic tests") +test_that("Sanity checks", { + expect_error( + CST_BiasCorrection(data = 1), + "Parameter 'data' must be a list as output of Load function + from s2dverification package") + + mod1 <- 1 : (1 * 3 * 4 * 5 * 6 * 7) + obs1 <- 1 : (1 * 1 * 4 * 5 * 6 * 7) + dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7) + dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, ftime = 5, lat = 6, lon = 7) + lon <- seq(0, 30, 5) + lat <- seq(0, 25, 5) + data <- list(mod = mod1, obs = obs1, lat = lat, lon = lon) + + expect_equal(length(CST_BiasCorrection(data = data)), 3) + expect_equal(dim(CST_BiasCorrection(data = data)$biascorrection), + c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7)) + expect_equal(CST_BiasCorrection(data = data)$lat, lat) + expect_equal(CST_BiasCorrection(data = data)$lon, lon) + + data <- list(mod = mod1, obs = mod1, lat = lat, lon = lon) + expect_error(CST_BiasCorrection(data = data), + "The length of the dimension 'member' in label 'obs' of parameter 'data' must be equal to 1.") + + mod2 <- mod1 + mod2[1, 2, 1, 1, 1, 1] <- NA + data <- list(mod = mod2, obs = obs1, lat = lat, lon = lon) + expect_warning( + CST_BiasCorrection(data = data), + "Parameter 'exp' contains NA values.") + + obs2 <- obs1 + obs2[1, 1, 2, 1, 1, 1] <- NA + data <- list(mod = mod1, obs = obs2, lat = lat, lon = lon) + expect_warning( + CST_BiasCorrection(data = data), + "Parameter 'obs' contains NA values.") + + data <- list( mod = mod2, obs = obs2, lat = lat, lon = lon) + expect_warning( + CST_BiasCorrection(data = data), + "Parameter 'obs' contains NA values", "Parameter 'exp' contains NA values.") +}) \ No newline at end of file -- GitLab