From 927be6cd50ba1af7f5b116ee9e15fd4652b8f397 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Tue, 9 May 2023 18:07:36 +0200 Subject: [PATCH 1/5] Imrpove function in order that it can plot daily observations in a year outside of the reference period --- R/PlotWeeklyClim.R | 128 ++++++++++++++++++++++++++++++++------------- 1 file changed, 92 insertions(+), 36 deletions(-) diff --git a/R/PlotWeeklyClim.R b/R/PlotWeeklyClim.R index 6f103d96..a5a95197 100644 --- a/R/PlotWeeklyClim.R +++ b/R/PlotWeeklyClim.R @@ -9,18 +9,25 @@ #' and time dimensions containing observed daily data. It can also be a #' dataframe with computed percentiles as input for ggplot. The target year #' must be included in the input data. -#'@param first_date The first date of the target period of timeseries. It can be -#' of class 'Date', 'POSIXct' or a character string in the format 'yyyy-mm-dd'. -#' It must be a date included in the reference period. -#'@param ref_period_ini A numeric value indicating the first year of the -#' reference period. -#'@param ref_period_end A numeric value indicating the last year of the -#' reference period. +#'@param first_date The first date of the observed values of timeseries. It can +#' be of class 'Date', 'POSIXct' or a character string in the format +#' 'yyyy-mm-dd'. It must be a date included in the reference period. +#'@param last_date Optional parameter indicating the last date of the target +#' period of the daily timeseries. If it is NULL, the last date of the +#' daily timeseries will be set as the last date of 'data' within the year +#' of th first_date parameter. +#'@param ref_period A vector of numeric values indicating the years of the +#' reference period. If parameter 'data_years' is not specified, it must +#' be of the same length of dimension 'sdate_dim' of parameter 'data'. +#'@param data_years A vector of numeric values indicating the years of the +#' data. It is optional. If not specified, all the years will be used as the +#' target period. #'@param time_dim A character string indicating the daily time dimension name. #' The default value is 'time'. #'@param sdate_dim A character string indicating the start year dimension name. #' The default value is 'sdate'. -#'@param title The text for the top title of the plot. +#'@param title The text for the top title of the plot. It is NULL by default. +#'@param subtitle The text for the subtitle of the plot. It is NULL bu default. #'@param palette A palette name from the R Color Brewer’s package. The default #' value is 'Blues'. #'@param fileout A character string indicating the file name where to save the @@ -40,10 +47,12 @@ #'@return A ggplot object containing the plot. #' #'@examples -#'data <- array(rnorm(49*20, 274, 7), dim = c(time = 49, sdate = 20)) -#'PlotWeeklyClim(data = data, first_date = '2010-08-09', -#' ref_period_ini = 1998, -#' ref_period_end = 2020) +#'data <- array(rnorm(49*20*3, 274, 7), dim = c(time = 49, sdate = 20, member = 3)) +#'PlotWeeklyClim(data = data, first_date = '2002-08-09', last_date = '2002-09-15', +#' ref_period = 2010:2019, data_years = 2000:2019, +#' time_dim = 'time', sdate_dim = 'sdate', +#' title = "Observed weekly means and climatology", +#' subtitle = "Target years: 2010 to 2019") #' #'@import multiApply #'@import lubridate @@ -53,11 +62,10 @@ #'@importFrom ClimProjDiags Subset #'@importFrom s2dv MeanDims #'@export -PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, - time_dim = 'time', sdate_dim = 'sdate', - title = "Observed weekly means and climatology", - palette = "Blues", fileout = NULL, - device = NULL, width = 8, height = 6, +PlotWeeklyClim <- function(data, first_date, last_date = NULL, ref_period, + data_years = NULL, time_dim = 'time', sdate_dim = 'sdate', + title = NULL, subtitle = NULL, palette = "Blues", + fileout = NULL, device = NULL, width = 8, height = 6, units = 'in', dpi = 300) { # Check input arguments # data @@ -99,10 +107,33 @@ PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, "A dimension of length 1 has been added.")) data <- InsertDim(data, 1, lendim = 1, name = sdate_dim) } - # ref_period_ini and ref_period_end - if (!is.numeric(ref_period_ini) | !is.numeric(ref_period_end)) { + # ref_period + if (!is.numeric(ref_period)) { stop("Parameters 'ref_period_ini' and 'ref_period_end' must be numeric.") } + taget_year_outside_reference <- FALSE + # data_years + if (!is.null(data_years)) { + if (!is.numeric(data_years)) { + stop("Parameter 'data_years' must be numeric.") + } + if (length(data_years) != dim(data)[sdate_dim]) { + stop(paste0("Parameter 'data_years' must have the same length as ", + "the dimension '", sdate_dim, "' of 'data'.")) + } + if (!all(ref_period %in% data_years)) { + stop(paste0("Parameter 'data_years' must contain the reference ", + "period.")) + } + taget_year_outside_reference <- TRUE + } else { + if (length(ref_period) != dim(data)[sdate_dim]) { + stop(paste0("The 'ref_period' must have the same length as the ", + "dimension 'sdate_dim' of 'data' if ", + "the 'data_years' is not provided.")) + } + data_years <- ref_period + } # first_date if ((!inherits(first_date, "POSIXct") & !inherits(first_date, "Date")) && (!is.character(first_date) | nchar(first_date) != 10)) { @@ -110,21 +141,55 @@ PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, "indicating the date in the format 'yyyy-mm-dd', 'POSIXct' ", "or 'Dates' class.")) } + # Dates creation first_date <- ymd(first_date) target_year <- year(first_date) - if (target_year < ref_period_ini | target_year > ref_period_end) { - stop("Parameter 'first_date' must be a date included in the reference period.") + if (!any(target_year %in% data_years)) { + stop(paste0("If data_years are NULL, parameter 'first_date' must ", + "be a date included in the reference period.")) + } + if (!is.null(last_date)) { + if ((!inherits(last_date, "POSIXct") & !inherits(last_date, "Date")) && + (!is.character(last_date) | nchar(last_date) != 10)) { + stop(paste0("Parameter 'last_date' must be a character string ", + "indicating the date in the format 'yyyy-mm-dd', 'POSIXct' ", + "or 'Dates' class.")) + } + last_date <- ymd(last_date) + dates <- seq(first_date, last_date, by = "1 day") + if (length(dates) > dim(data)[time_dim]) { + warning(paste0("Parameter 'last_date' is greater than the last date ", + "of 'data'. The last date of 'data' will be used.")) + dates <- seq(first_date, first_date + days(dim(data)[time_dim]-1), by = "1 day") + } + } else { + dates <- seq(first_date, first_date + days(dim(data)[time_dim]-1), by = "1 day") } - - # Dates creation - dates <- seq(first_date, first_date + days(dim(data)[time_dim]-1), by = "1 day") index_first_date <- which(dates == first_date) index_last_date <- length(dates) - (length(dates) %% 7) last_date <- dates[index_last_date] - # Weekly aggregations + # subset data for weeks data_subset <- Subset(data, along = time_dim, indices = index_first_date:index_last_date) + + # subset other dimensions + dims_subset <- names(dim(data_subset))[which(!names(dim(data_subset)) %in% c(time_dim, sdate_dim))] + if (!identical(dims_subset, character(0))) { + data_subset <- Subset(data_subset, dims_subset, as.list(rep(1, length(dims_subset))), drop = TRUE) + } + # observed daily data for target year not included in reference period + daily <- Subset(data_subset, along = sdate_dim, + indices = which(data_years == target_year), + drop = TRUE) + if (taget_year_outside_reference) { + indexes_reference_period <- which(data_years %in% ref_period) + # subset data for reference period + data_subset <- Subset(data_subset, along = sdate_dim, + indices = indexes_reference_period) + } + + # Weekly aggregations for reference period weekly_aggre <- SplitDim(data_subset, split_dim = time_dim, indices = sort(rep(1:(length(index_first_date:index_last_date)/7), 7)), new_dim_name = 'week') @@ -148,16 +213,7 @@ PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, p66 = as.vector(weekly_p66), week = 1:(length(index_first_date:index_last_date)/7)) - daily <- Subset(data_subset, along = sdate_dim, - indices = which(ref_period_ini:ref_period_end == target_year), - drop = TRUE) - - dims_subset <- names(dim(daily))[which(!names(dim(daily)) %in% c(time_dim, sdate_dim))] - - if (!identical(dims_subset, character(0))) { - daily <- Subset(daily, dims_subset, as.list(rep(1, length(dims_subset))), drop = TRUE) - } - + # observations for target year daily_data <- data.frame(day = seq(first_date, last_date, by = "1 day"), data = daily, week = sort(rep(1:(length(index_first_date:index_last_date)/7), 7))) @@ -187,7 +243,7 @@ PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, linetype = "observed weekly mean"), alpha = 1, size = 0.7) + # weekly evolution theme_bw() + ylab(paste0('tas', " (", "deg.C", ")")) + xlab(NULL) + - ggtitle(title) + + ggtitle(title, subtitle = subtitle) + scale_x_date(breaks = seq(min(all$day), max(all$day), by = "7 days"), minor_breaks = NULL, expand = c(0.03, 0.03), labels = date_format("%d %b %Y")) + -- GitLab From 72eff421f5bf62c53989b427936a99f06db393b5 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 10 May 2023 14:23:21 +0200 Subject: [PATCH 2/5] Add plot parameters, imrpove error messages and improve test file --- R/PlotWeeklyClim.R | 126 ++++++++++++++++----------- man/PlotWeeklyClim.Rd | 63 ++++++++++---- tests/testthat/test-PlotWeeklyClim.R | 88 ++++++++++++++----- 3 files changed, 187 insertions(+), 90 deletions(-) diff --git a/R/PlotWeeklyClim.R b/R/PlotWeeklyClim.R index a5a95197..45ccfd8a 100644 --- a/R/PlotWeeklyClim.R +++ b/R/PlotWeeklyClim.R @@ -7,20 +7,26 @@ #' #'@param data A multidimensional array with named dimensions with at least sdate #' and time dimensions containing observed daily data. It can also be a -#' dataframe with computed percentiles as input for ggplot. The target year -#' must be included in the input data. +#' dataframe with computed percentiles as input for ggplot. If it's a +#' dataframe, it must contain the following column names: 'week', 'clim', +#' 'p10', 'p90', 'p33', 'p66', 'week_mean', 'day' and 'data'. #'@param first_date The first date of the observed values of timeseries. It can #' be of class 'Date', 'POSIXct' or a character string in the format -#' 'yyyy-mm-dd'. It must be a date included in the reference period. +#' 'yyyy-mm-dd'. If parameter 'data_years' is not provided, it must be a date +#' included in the reference period. #'@param last_date Optional parameter indicating the last date of the target -#' period of the daily timeseries. If it is NULL, the last date of the -#' daily timeseries will be set as the last date of 'data' within the year -#' of th first_date parameter. +#' period of the daily timeseries. It can be of class 'Date', 'POSIXct' or a +#' character string in the format 'yyyy-mm-dd'. If it is NULL, the last date of +#' the daily timeseries will be set as the last date of 'data'. As the data is +#' plotted by weeks, only full groups of 7 days will be plotted. If the last +#' date of the timeseries is not a multiple of 7 days, the last week will +#' not be plotted. #'@param ref_period A vector of numeric values indicating the years of the #' reference period. If parameter 'data_years' is not specified, it must #' be of the same length of dimension 'sdate_dim' of parameter 'data'. #'@param data_years A vector of numeric values indicating the years of the -#' data. It is optional. If not specified, all the years will be used as the +#' data. It must be of the same length of dimension 'sdate_dim' of parameter +#' 'data'. It is optional, if not specified, all the years will be used as the #' target period. #'@param time_dim A character string indicating the daily time dimension name. #' The default value is 'time'. @@ -28,6 +34,11 @@ #' The default value is 'sdate'. #'@param title The text for the top title of the plot. It is NULL by default. #'@param subtitle The text for the subtitle of the plot. It is NULL bu default. +#'@param ytitle Character string to be drawn as y-axis title. It is NULL by +#' default. +#'@param legend A logical value indicating whether a legend should be included +#' in the plot. If it is TRUE or NA, the legend will be included. If it is +#' FALSE, the legend will not be included. It is TRUE by default. #'@param palette A palette name from the R Color Brewer’s package. The default #' value is 'Blues'. #'@param fileout A character string indicating the file name where to save the @@ -47,12 +58,13 @@ #'@return A ggplot object containing the plot. #' #'@examples -#'data <- array(rnorm(49*20*3, 274, 7), dim = c(time = 49, sdate = 20, member = 3)) -#'PlotWeeklyClim(data = data, first_date = '2002-08-09', last_date = '2002-09-15', -#' ref_period = 2010:2019, data_years = 2000:2019, -#' time_dim = 'time', sdate_dim = 'sdate', +#'data <- array(rnorm(49*20*3, 274), dim = c(time = 49, sdate = 20, member = 3)) +#'PlotWeeklyClim(data = data, first_date = '2002-08-09', +#' last_date = '2002-09-15', ref_period = 2010:2019, +#' data_years = 2000:2019, time_dim = 'time', sdate_dim = 'sdate', #' title = "Observed weekly means and climatology", -#' subtitle = "Target years: 2010 to 2019") +#' subtitle = "Target years: 2010 to 2019", +#' ytitle = paste0('tas', " (", "deg.C", ")")) #' #'@import multiApply #'@import lubridate @@ -62,11 +74,12 @@ #'@importFrom ClimProjDiags Subset #'@importFrom s2dv MeanDims #'@export -PlotWeeklyClim <- function(data, first_date, last_date = NULL, ref_period, - data_years = NULL, time_dim = 'time', sdate_dim = 'sdate', - title = NULL, subtitle = NULL, palette = "Blues", - fileout = NULL, device = NULL, width = 8, height = 6, - units = 'in', dpi = 300) { +PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, + data_years = NULL, time_dim = 'time', + sdate_dim = 'sdate', title = NULL, subtitle = NULL, + ytitle = NULL, legend = TRUE, + palette = "Blues", fileout = NULL, device = NULL, + width = 8, height = 6, units = 'in', dpi = 300) { # Check input arguments # data if (is.array(data)) { @@ -107,10 +120,28 @@ PlotWeeklyClim <- function(data, first_date, last_date = NULL, ref_period, "A dimension of length 1 has been added.")) data <- InsertDim(data, 1, lendim = 1, name = sdate_dim) } - # ref_period + # legend + if (!is.logical(legend)) { + stop("Parameter 'legend' must be a logical value.") + } + if (is.na(legend)) { + legend <- TRUE + } else if (legend) { + legend <- NA + } + # ref_period (1) if (!is.numeric(ref_period)) { - stop("Parameters 'ref_period_ini' and 'ref_period_end' must be numeric.") + stop("Parameter 'ref_period' must be numeric.") + } + # first_date + if ((!inherits(first_date, "POSIXct") & !inherits(first_date, "Date")) && + (!is.character(first_date) | nchar(first_date) != 10)) { + stop(paste0("Parameter 'first_date' must be a character string ", + "indicating the date in the format 'yyyy-mm-dd', 'POSIXct' ", + "or 'Dates' class.")) } + first_date <- ymd(first_date) + target_year <- year(first_date) taget_year_outside_reference <- FALSE # data_years if (!is.null(data_years)) { @@ -122,32 +153,28 @@ PlotWeeklyClim <- function(data, first_date, last_date = NULL, ref_period, "the dimension '", sdate_dim, "' of 'data'.")) } if (!all(ref_period %in% data_years)) { - stop(paste0("Parameter 'data_years' must contain the reference ", + stop(paste0("The 'ref_period' must be included in the 'data_years' ", "period.")) } + if (!any(target_year %in% data_years)) { + stop(paste0("Parameter 'first_date' must be a date included ", + "in the 'data_years' period.")) + } taget_year_outside_reference <- TRUE } else { + # ref_period (2) if (length(ref_period) != dim(data)[sdate_dim]) { - stop(paste0("The 'ref_period' must have the same length as the ", - "dimension 'sdate_dim' of 'data' if ", - "the 'data_years' is not provided.")) + stop(paste0("Parameter 'ref_period' must have the same length as the ", + "dimension '", sdate_dim ,"' of 'data' if ", + "'data_years' is not provided.")) + } + if (!any(target_year %in% ref_period)) { + stop(paste0("If parameter 'data_years' is NULL, parameter 'first_date' ", + "must be a date included in the 'ref_period' period.")) } data_years <- ref_period } - # first_date - if ((!inherits(first_date, "POSIXct") & !inherits(first_date, "Date")) && - (!is.character(first_date) | nchar(first_date) != 10)) { - stop(paste0("Parameter 'first_date' must be a character string ", - "indicating the date in the format 'yyyy-mm-dd', 'POSIXct' ", - "or 'Dates' class.")) - } - # Dates creation - first_date <- ymd(first_date) - target_year <- year(first_date) - if (!any(target_year %in% data_years)) { - stop(paste0("If data_years are NULL, parameter 'first_date' must ", - "be a date included in the reference period.")) - } + # last_date if (!is.null(last_date)) { if ((!inherits(last_date, "POSIXct") & !inherits(last_date, "Date")) && (!is.character(last_date) | nchar(last_date) != 10)) { @@ -169,27 +196,28 @@ PlotWeeklyClim <- function(data, first_date, last_date = NULL, ref_period, index_last_date <- length(dates) - (length(dates) %% 7) last_date <- dates[index_last_date] - # subset data for weeks + ## Data preparation + # subset time_dim for weeks data_subset <- Subset(data, along = time_dim, indices = index_first_date:index_last_date) - # subset other dimensions + # remove other dimensions dims_subset <- names(dim(data_subset))[which(!names(dim(data_subset)) %in% c(time_dim, sdate_dim))] if (!identical(dims_subset, character(0))) { data_subset <- Subset(data_subset, dims_subset, as.list(rep(1, length(dims_subset))), drop = TRUE) } - # observed daily data for target year not included in reference period + # observed daily data creation daily <- Subset(data_subset, along = sdate_dim, indices = which(data_years == target_year), drop = TRUE) if (taget_year_outside_reference) { indexes_reference_period <- which(data_years %in% ref_period) - # subset data for reference period + # remove values outside reference period for computing the means data_subset <- Subset(data_subset, along = sdate_dim, indices = indexes_reference_period) } - # Weekly aggregations for reference period + ## Weekly aggregations for reference period weekly_aggre <- SplitDim(data_subset, split_dim = time_dim, indices = sort(rep(1:(length(index_first_date:index_last_date)/7), 7)), new_dim_name = 'week') @@ -213,7 +241,7 @@ PlotWeeklyClim <- function(data, first_date, last_date = NULL, ref_period, p66 = as.vector(weekly_p66), week = 1:(length(index_first_date:index_last_date)/7)) - # observations for target year + ## observations for target year daily_data <- data.frame(day = seq(first_date, last_date, by = "1 day"), data = daily, week = sort(rep(1:(length(index_first_date:index_last_date)/7), 7))) @@ -230,19 +258,19 @@ PlotWeeklyClim <- function(data, first_date, last_date = NULL, ref_period, p <- ggplot(all, aes(x = day)) + geom_ribbon(aes(ymin = p10, ymax = p90, group = week, fill = "p10-p90"), - alpha = 0.7) + # extremes clim + alpha = 0.7, show.legend = legend) + # extremes clim geom_ribbon(aes(ymin = p33, ymax = p66, group = week, fill = "p33-p66"), - alpha = 0.7) + # terciles clim + alpha = 0.7, show.legend = legend) + # terciles clim geom_line(aes(y = clim, group = week, color = "climatological mean", linetype = "climatological mean"), - alpha = 1.0, size = 0.7) + # mean clim + alpha = 1.0, size = 0.7, show.legend = legend) + # mean clim geom_line(aes(y = data, color = "observed daily mean", linetype = "observed daily mean"), - alpha = 1, size = 0.2) + # daily evolution + alpha = 1, size = 0.2, show.legend = legend) + # daily evolution geom_line(aes(y = week_mean, group = week, color = "observed weekly mean", linetype = "observed weekly mean"), - alpha = 1, size = 0.7) + # weekly evolution - theme_bw() + ylab(paste0('tas', " (", "deg.C", ")")) + xlab(NULL) + + alpha = 1, size = 0.7, show.legend = legend) + # weekly evolution + theme_bw() + ylab(ytitle) + xlab(NULL) + ggtitle(title, subtitle = subtitle) + scale_x_date(breaks = seq(min(all$day), max(all$day), by = "7 days"), minor_breaks = NULL, expand = c(0.03, 0.03), diff --git a/man/PlotWeeklyClim.Rd b/man/PlotWeeklyClim.Rd index 746c641e..788f736c 100644 --- a/man/PlotWeeklyClim.Rd +++ b/man/PlotWeeklyClim.Rd @@ -7,11 +7,15 @@ PlotWeeklyClim( data, first_date, - ref_period_ini, - ref_period_end, + ref_period, + last_date = NULL, + data_years = NULL, time_dim = "time", sdate_dim = "sdate", - title = "Observed weekly means and climatology", + title = NULL, + subtitle = NULL, + ytitle = NULL, + legend = TRUE, palette = "Blues", fileout = NULL, device = NULL, @@ -24,18 +28,31 @@ PlotWeeklyClim( \arguments{ \item{data}{A multidimensional array with named dimensions with at least sdate and time dimensions containing observed daily data. It can also be a -dataframe with computed percentiles as input for ggplot. The target year -must be included in the input data.} +dataframe with computed percentiles as input for ggplot. If it's a +dataframe, it must contain the following column names: 'week', 'clim', +'p10', 'p90', 'p33', 'p66', 'week_mean', 'day' and 'data'.} -\item{first_date}{The first date of the target period of timeseries. It can be -of class 'Date', 'POSIXct' or a character string in the format 'yyyy-mm-dd'. -It must be a date included in the reference period.} +\item{first_date}{The first date of the observed values of timeseries. It can +be of class 'Date', 'POSIXct' or a character string in the format +'yyyy-mm-dd'. If parameter 'data_years' is not provided, it must be a date +included in the reference period.} -\item{ref_period_ini}{A numeric value indicating the first year of the -reference period.} +\item{ref_period}{A vector of numeric values indicating the years of the +reference period. If parameter 'data_years' is not specified, it must +be of the same length of dimension 'sdate_dim' of parameter 'data'.} -\item{ref_period_end}{A numeric value indicating the last year of the -reference period.} +\item{last_date}{Optional parameter indicating the last date of the target +period of the daily timeseries. It can be of class 'Date', 'POSIXct' or a +character string in the format 'yyyy-mm-dd'. If it is NULL, the last date of +the daily timeseries will be set as the last date of 'data'. As the data is +plotted by weeks, only full groups of 7 days will be plotted. If the last +date of the timeseries is not a multiple of 7 days, the last week will +not be plotted.} + +\item{data_years}{A vector of numeric values indicating the years of the +data. It must be of the same length of dimension 'sdate_dim' of parameter +'data'. It is optional, if not specified, all the years will be used as the +target period.} \item{time_dim}{A character string indicating the daily time dimension name. The default value is 'time'.} @@ -43,7 +60,16 @@ The default value is 'time'.} \item{sdate_dim}{A character string indicating the start year dimension name. The default value is 'sdate'.} -\item{title}{The text for the top title of the plot.} +\item{title}{The text for the top title of the plot. It is NULL by default.} + +\item{subtitle}{The text for the subtitle of the plot. It is NULL bu default.} + +\item{ytitle}{Character string to be drawn as y-axis title. It is NULL by +default.} + +\item{legend}{A logical value indicating whether a legend should be included +in the plot. If it is TRUE or NA, the legend will be included. If it is +FALSE, the legend will not be included. It is TRUE by default.} \item{palette}{A palette name from the R Color Brewer’s package. The default value is 'Blues'.} @@ -77,9 +103,12 @@ a specified period (reference period) to the observed conditions during the target period analyzed in the case study (included in the reference period). } \examples{ -data <- array(rnorm(49*20, 274, 7), dim = c(time = 49, sdate = 20)) -PlotWeeklyClim(data = data, first_date = '2010-08-09', - ref_period_ini = 1998, - ref_period_end = 2020) +data <- array(rnorm(49*20*3, 274), dim = c(time = 49, sdate = 20, member = 3)) +PlotWeeklyClim(data = data, first_date = '2002-08-09', + last_date = '2002-09-15', ref_period = 2010:2019, + data_years = 2000:2019, time_dim = 'time', sdate_dim = 'sdate', + title = "Observed weekly means and climatology", + subtitle = "Target years: 2010 to 2019", + ytitle = paste0('tas', " (", "deg.C", ")")) } diff --git a/tests/testthat/test-PlotWeeklyClim.R b/tests/testthat/test-PlotWeeklyClim.R index e7886fbc..1e748e3b 100644 --- a/tests/testthat/test-PlotWeeklyClim.R +++ b/tests/testthat/test-PlotWeeklyClim.R @@ -4,6 +4,7 @@ context("CSTools::PlotWeeklyClim tests") # dat1 dat1 <- array(rnorm(1*7), dim = c(dat = 1, var = 1, sdate = 1, time = 7)) +dat2 <- array(rnorm(21), dim = c(dat = 1, var = 1, sdate = 3, time = 7)) ############################################## @@ -11,79 +12,118 @@ test_that("1. Input checks", { # data expect_error( PlotWeeklyClim(data = array(1:92), first_date = '2020-03-01', - ref_period_ini = 1993, ref_period_end = 2021), + ref_period = 1993:2021), "Parameter 'data' must have named dimensions." ) expect_error( PlotWeeklyClim(data = data.frame(week = 1:92), first_date = '2020-03-01', - ref_period_ini = 1993, ref_period_end = 2021), + ref_period = 1993:2021), paste0("If parameter 'data' is a data frame, it must contain the ", "following column names: 'week', 'clim', 'p10', 'p90', 'p33', ", "'p66', 'week_mean', 'day' and 'data'.") ) expect_error( PlotWeeklyClim(data = 1:92, first_date = '2020-03-01', - ref_period_ini = 1993, ref_period_end = 2021), + ref_period = 1993:2021), "Parameter 'data' must be an array or a data frame." ) # time_dim expect_error( PlotWeeklyClim(data = dat1, first_date = '2020-03-01', - ref_period_ini = 2020, ref_period_end = 2020, time_dim = 1), + ref_period = 2020, time_dim = 1), "Parameter 'time_dim' must be a character string." ) expect_error( PlotWeeklyClim(data = array(rnorm(1), dim = c(dat = 1)), - first_date = '2020-03-01', ref_period_ini = 2020, - ref_period_end = 2020), + first_date = '2020-03-01', ref_period = 2020), "Parameter 'time_dim' is not found in 'data' dimension." ) expect_error( PlotWeeklyClim(data = array(rnorm(1*7), dim = c(time = 6)), - first_date = '2020-03-01', ref_period_ini = 2020, - ref_period_end = 2020), + first_date = '2020-03-01', ref_period = 2020), paste0("Parameter 'data' must have the dimension 'time_dim' of length ", "equal or grater than 7 to compute the weekly means.") ) # sdate_dim expect_error( PlotWeeklyClim(data = dat1, first_date = '2020-03-01', - ref_period_ini = 2020, ref_period_end = 2020, - sdate_dim = 1), + ref_period = 2020, sdate_dim = 1), "Parameter 'sdate_dim' must be a character string." ) expect_warning( PlotWeeklyClim(data = array(rnorm(7), dim = c(time = 7)), - first_date = '2020-03-01', ref_period_ini = 2020, - ref_period_end = 2020), + first_date = '2020-03-01', ref_period = 2020), paste0("Parameter 'sdate_dim' is not found in 'data' dimension. ", "A dimension of length 1 has been added.") ) - # ref_period_ini + # legend expect_error( PlotWeeklyClim(data = dat1, first_date = '2020-03-01', - ref_period_ini = "2020", ref_period_end = 2020), - "Parameters 'ref_period_ini' and 'ref_period_end' must be numeric." + ref_period = 2020, legend = 1), + "Parameter 'legend' must be a logical value." + ) + # ref_period (1) + expect_error( + PlotWeeklyClim(data = dat1, first_date = '2020-03-01', ref_period = "2020"), + "Parameter 'ref_period' must be numeric." ) # first_date expect_error( - PlotWeeklyClim(data = dat1, first_date = 2020-03-01, - ref_period_ini = 2020, ref_period_end = 2020), + PlotWeeklyClim(data = dat1, first_date = 2020-03-01, ref_period = 2020), paste0("Parameter 'first_date' must be a character string ", "indicating the date in the format 'yyyy-mm-dd', 'POSIXct' ", "or 'Dates' class.") ) + # data_years expect_error( - PlotWeeklyClim(data = dat1, first_date = 'a', - ref_period_ini = 2020, ref_period_end = 2020), - paste0("Parameter 'first_date' must be a character string ", + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', ref_period = 2020, + data_years = '2020'), + "Parameter 'data_years' must be numeric." + ) + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', ref_period = 2020, + data_years = 2005:2020), + paste0("Parameter 'data_years' must have the same length as the ", + "dimension 'sdate' of 'data'.") + ) + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2010-03-01', + ref_period = 2020:2021, data_years = 2018:2020), + paste0("The 'ref_period' must be included in the 'data_years' ", + "period.") + ) + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2021-03-01', + ref_period = 2018:2019, data_years = 2018:2020), + paste0("Parameter 'first_date' must be a date included ", + "in the 'data_years' period.") + ) + # ref_period (2) + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2021), + paste0("Parameter 'ref_period' must have the same length as the ", + "dimension 'sdate' of 'data' if 'data_years' is not provided.") + ) + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2017:2019), + paste0("If parameter 'data_years' is NULL, parameter 'first_date' ", + "must be a date included in the 'ref_period' period.") + ) + # last_date + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2022, last_date = 2020-03-01), + paste0("Parameter 'last_date' must be a character string ", "indicating the date in the format 'yyyy-mm-dd', 'POSIXct' ", "or 'Dates' class.") ) - expect_error( - PlotWeeklyClim(data = dat1, first_date = '2020-03-01', ref_period_ini = 2021, - ref_period_end = 2022), - "Parameter 'first_date' must be a date included in the reference period." + expect_warning( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2022, last_date = '2020-03-08'), + paste0("Parameter 'last_date' is greater than the last date ", + "of 'data'. The last date of 'data' will be used.") ) }) -- GitLab From af3e8eee9231afdbc595ea4b9141388fea6e1f73 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 10 May 2023 14:32:11 +0200 Subject: [PATCH 3/5] Remove the text reffered to target year included in the reference period --- R/PlotWeeklyClim.R | 17 ++--------------- man/PlotWeeklyClim.Rd | 2 +- 2 files changed, 3 insertions(+), 16 deletions(-) diff --git a/R/PlotWeeklyClim.R b/R/PlotWeeklyClim.R index 45ccfd8a..5cafd089 100644 --- a/R/PlotWeeklyClim.R +++ b/R/PlotWeeklyClim.R @@ -3,7 +3,7 @@ #'@description This function plots the observed weekly means and climatology of #'a timeseries data using ggplot package. It compares the weekly climatology in #'a specified period (reference period) to the observed conditions during the -#'target period analyzed in the case study (included in the reference period). +#'target period analyzed in the case study. #' #'@param data A multidimensional array with named dimensions with at least sdate #' and time dimensions containing observed daily data. It can also be a @@ -299,17 +299,4 @@ PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, ggsave(filename = fileout, plot = p, device = device, height = height, width = width, units = units, dpi = dpi) } -} - - - - - - - - - - - - - \ No newline at end of file +} \ No newline at end of file diff --git a/man/PlotWeeklyClim.Rd b/man/PlotWeeklyClim.Rd index 788f736c..9f17f022 100644 --- a/man/PlotWeeklyClim.Rd +++ b/man/PlotWeeklyClim.Rd @@ -100,7 +100,7 @@ A ggplot object containing the plot. This function plots the observed weekly means and climatology of a timeseries data using ggplot package. It compares the weekly climatology in a specified period (reference period) to the observed conditions during the -target period analyzed in the case study (included in the reference period). +target period analyzed in the case study. } \examples{ data <- array(rnorm(49*20*3, 274), dim = c(time = 49, sdate = 20, member = 3)) -- GitLab From 895e7666d05d38d0df70e30ddb34fc57671c3ada Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 10 May 2023 14:34:39 +0200 Subject: [PATCH 4/5] Improve comments --- R/PlotWeeklyClim.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/PlotWeeklyClim.R b/R/PlotWeeklyClim.R index 5cafd089..fbd73263 100644 --- a/R/PlotWeeklyClim.R +++ b/R/PlotWeeklyClim.R @@ -80,7 +80,7 @@ PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, ytitle = NULL, legend = TRUE, palette = "Blues", fileout = NULL, device = NULL, width = 8, height = 6, units = 'in', dpi = 300) { - # Check input arguments + ## Check input arguments # data if (is.array(data)) { if (is.null(names(dim(data)))) { @@ -241,7 +241,7 @@ PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, p66 = as.vector(weekly_p66), week = 1:(length(index_first_date:index_last_date)/7)) - ## observations for target year + ## Prepare observations from target year daily_data <- data.frame(day = seq(first_date, last_date, by = "1 day"), data = daily, week = sort(rep(1:(length(index_first_date:index_last_date)/7), 7))) @@ -253,7 +253,7 @@ PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, all <- data } - # Create a ggplot object + ## Create a ggplot object cols <- colorRampPalette(brewer.pal(9, palette))(6) p <- ggplot(all, aes(x = day)) + -- GitLab From 8b72612089ea06951c8c372dbfe1d6a6868f8f84 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 5 Jul 2023 12:52:00 +0200 Subject: [PATCH 5/5] Add ylim parameter in PlotWeeklyClim; added test and documentation --- R/PlotWeeklyClim.R | 15 +++++++++++++-- man/PlotWeeklyClim.Rd | 5 +++++ tests/testthat/test-PlotWeeklyClim.R | 7 +++++++ 3 files changed, 25 insertions(+), 2 deletions(-) diff --git a/R/PlotWeeklyClim.R b/R/PlotWeeklyClim.R index fbd73263..48e71328 100644 --- a/R/PlotWeeklyClim.R +++ b/R/PlotWeeklyClim.R @@ -32,6 +32,9 @@ #' The default value is 'time'. #'@param sdate_dim A character string indicating the start year dimension name. #' The default value is 'sdate'. +#'@param ylim A numeric vector of length two providing limits of the scale. +#' Use NA to refer to the existing minimum or maximum. For more information, +#' see 'ggplot2' documentation of 'scale_y_continuous' parameter. #'@param title The text for the top title of the plot. It is NULL by default. #'@param subtitle The text for the subtitle of the plot. It is NULL bu default. #'@param ytitle Character string to be drawn as y-axis title. It is NULL by @@ -76,7 +79,8 @@ #'@export PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, data_years = NULL, time_dim = 'time', - sdate_dim = 'sdate', title = NULL, subtitle = NULL, + sdate_dim = 'sdate', ylim = NULL, + title = NULL, subtitle = NULL, ytitle = NULL, legend = TRUE, palette = "Blues", fileout = NULL, device = NULL, width = 8, height = 6, units = 'in', dpi = 300) { @@ -192,6 +196,12 @@ PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, } else { dates <- seq(first_date, first_date + days(dim(data)[time_dim]-1), by = "1 day") } + # ylim + if (is.character(ylim)) { + warning("Parameter 'ylim' can't be a character string, it will not be used.") + ylim <- NULL + } + index_first_date <- which(dates == first_date) index_last_date <- length(dates) - (length(dates) %% 7) last_date <- dates[index_last_date] @@ -290,7 +300,8 @@ PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, "observed daily mean" = "dashed", "observed weekly mean" = "solid"), guide = guide_legend(override.aes = list(lwd = c(0.7, 0.2, 0.7)))) + - guides(fill = guide_legend(order = 1)) + guides(fill = guide_legend(order = 1)) + + scale_y_continuous(limits = ylim) # Return the ggplot object if (is.null(fileout)) { diff --git a/man/PlotWeeklyClim.Rd b/man/PlotWeeklyClim.Rd index 9f17f022..3e064e8d 100644 --- a/man/PlotWeeklyClim.Rd +++ b/man/PlotWeeklyClim.Rd @@ -12,6 +12,7 @@ PlotWeeklyClim( data_years = NULL, time_dim = "time", sdate_dim = "sdate", + ylim = NULL, title = NULL, subtitle = NULL, ytitle = NULL, @@ -60,6 +61,10 @@ The default value is 'time'.} \item{sdate_dim}{A character string indicating the start year dimension name. The default value is 'sdate'.} +\item{ylim}{A numeric vector of length two providing limits of the scale. +Use NA to refer to the existing minimum or maximum. For more information, +see 'ggplot2' documentation of 'scale_y_continuous' parameter.} + \item{title}{The text for the top title of the plot. It is NULL by default.} \item{subtitle}{The text for the subtitle of the plot. It is NULL bu default.} diff --git a/tests/testthat/test-PlotWeeklyClim.R b/tests/testthat/test-PlotWeeklyClim.R index f8d9639b..5fc203f4 100644 --- a/tests/testthat/test-PlotWeeklyClim.R +++ b/tests/testthat/test-PlotWeeklyClim.R @@ -123,6 +123,13 @@ test_that("1. Input checks", { paste0("Parameter 'last_date' is greater than the last date ", "of 'data'. The last date of 'data' will be used.") ) + # ylim + expect_warning( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2022, ylim = 'i'), + paste0("Parameter 'ylim' can't be a character string, it will ", + "not be used.") + ) }) ############################################## \ No newline at end of file -- GitLab