diff --git a/R/gsdd-cf.R b/R/gsdd-cf.R index de4ce2c..b7877fc 100644 --- a/R/gsdd-cf.R +++ b/R/gsdd-cf.R @@ -5,22 +5,18 @@ #' beginning of winter. #' It is the accumulated thermal units (in C) #' during the growing season based on the mean daily water temperature values. +#' Only GSDD values calculated using the default values should be considered +#' equivalent to those of Coleman and Fausch (2007). #' #' The GSDD is calculated across the longest consecutive sequence of non-missing #' values which must be at least 184 elements in length otherwise a #' missing value is returned. -#' If the time series includes missing values it is recommended that they are +#' If the vector includes missing values it is recommended that they are #' replaced by estimates of the actual values using linear #' interpolation (`[interpolate_numeric_vector()]`) or other predictive methods. -#' If the user removes the missing values then the returned GSDD value -#' will be less than the actual GSDD. -#' -#' Truncation occurs when the start and/or end -#' of the time series is part way through a growing season. -#' If the user chooses to ignore truncation then the returned value -#' will be less than the actual GSDD. #' -#' By default the growing season is based on the interpretation of +#' By default the default values and implementation of the +#' growing season are based on the interpretation of #' Coleman and Fausch (2007) who stated that #' #' We defined the start of the growing season as the @@ -44,6 +40,11 @@ #' season with the `"biggest"` GSDD is selected. #' Conversely in the case of multiple `"shortest"` seasons then the #' candidate with the `"smallest"` GSDD is selected. +#' +#' Truncation occurs when the start and/or end +#' of the time series is part way through a growing season. +#' If the user chooses to ignore truncation then the returned value +#' will be less than the actual GSDD. #' #' @param x A numeric vector of the #' mean daily water temperature values for the period @@ -51,8 +52,8 @@ #' 366 values. #' @param ignore_truncation A flag specifying whether to ignore truncation #' of the mean daily water temperature vector -#' or a string of "start", "end", "none" or "both" -#' specifying which type of truncation to ignore. +#' or a string of "start", "end", "none" (equivalent to FALSE) or "both" +#' (equivalent to TRUE) specifying which type of truncation to ignore. #' @param start_temp A positive real number of the average water temperature #' at the start of the growing season in C. #' @param end_temp A positive real number of the average water temperature @@ -64,8 +65,7 @@ #' "longest", "shortest", "first" or "last" 'season' or the season with the #' "biggest" or "smallest" GSDD. By default the returned value is the #' sum of the GSDD values for "all" 'seasons'. -#' @param quiet A flag specifying whether to suppress warnings. -#' +#' @param msgs A flag specifying whether to provide messages. #' @return A non-negative real number of the GSDD. #' @export #' @@ -78,10 +78,10 @@ gsdd_cf <- function(x, end_temp = 4, window_width = 7, pick = "all", - quiet = FALSE) { + msgs = TRUE) { chk_numeric(x) chk_vector(x) - chk_length(x, 0, 366) + chk_lte(length(x), 366) chkor_vld(vld_flag(ignore_truncation), vld_string(ignore_truncation)) if (isTRUE(ignore_truncation)) { @@ -103,13 +103,19 @@ gsdd_cf <- function(x, chk_subset( pick, c("biggest", "smallest", "longest", "shortest", "first", "last", "all")) - chk_flag(quiet) + chk_flag(msgs) if(length(x) < 184) { + if (msgs) { + msg("`The length of `x` must be at least 184. Returning `NA`.") + } return(NA_real_) } x <- longest_run(x) if(length(x) < 184 || anyNA(x)) { + if(msgs) { + msg("The length of the longest non-missing sequence in `x` must be at least 184. Returning `NA`.") + } return(NA_real_) } # create rolling mean vector from x and window width @@ -126,10 +132,10 @@ gsdd_cf <- function(x, # if season starts on first day, ignore_truncation left if (index_start[1] == 1L) { truncated <- TRUE - if (!quiet) { - warning("Growing season truncated.") - } if (ignore_truncation %in% c("none", "end")) { + if (msgs) { + msg("The growing season is truncated at the end of the sequence. Returning `NA`.") + } return(NA_real_) } } @@ -137,10 +143,10 @@ gsdd_cf <- function(x, index_end <- index_begin_run(rollmean < end_temp) # if season doesnt end ignore_truncation right if (!length(index_end) || max(index_start) > max(index_end)) { - if (!truncated && !quiet) { - warning("Growing season truncated.") - } if (ignore_truncation %in% c("none", "start")) { + if (msgs) { + msg("The growing season is truncated at the start of the sequence. Returning `NA`.") + } return(NA_real_) } index_end <- c(index_end, length(rollmean)) diff --git a/man/gsdd_cf.Rd b/man/gsdd_cf.Rd index 9374d7d..4880324 100644 --- a/man/gsdd_cf.Rd +++ b/man/gsdd_cf.Rd @@ -11,7 +11,7 @@ gsdd_cf( end_temp = 4, window_width = 7, pick = "all", - quiet = FALSE + msgs = TRUE ) } \arguments{ @@ -22,8 +22,8 @@ of interest in C. It must be consist of no more than \item{ignore_truncation}{A flag specifying whether to ignore truncation of the mean daily water temperature vector -or a string of "start", "end", "none" or "both" -specifying which type of truncation to ignore.} +or a string of "start", "end", "none" (equivalent to FALSE) or "both" +(equivalent to TRUE) specifying which type of truncation to ignore.} \item{start_temp}{A positive real number of the average water temperature at the start of the growing season in C.} @@ -40,7 +40,7 @@ width of the rolling mean window in days. By default 7.} "biggest" or "smallest" GSDD. By default the returned value is the sum of the GSDD values for "all" 'seasons'.} -\item{quiet}{A flag specifying whether to suppress warnings.} +\item{msgs}{A flag specifying whether to provide messages.} } \value{ A non-negative real number of the GSDD. @@ -51,23 +51,19 @@ that is a useful predictor of Cutthroat trout size at the beginning of winter. It is the accumulated thermal units (in C) during the growing season based on the mean daily water temperature values. +Only GSDD values calculated using the default values should be considered +equivalent to those of Coleman and Fausch (2007). } \details{ The GSDD is calculated across the longest consecutive sequence of non-missing values which must be at least 184 elements in length otherwise a missing value is returned. -If the time series includes missing values it is recommended that they are +If the vector includes missing values it is recommended that they are replaced by estimates of the actual values using linear interpolation (\verb{[interpolate_numeric_vector()]}) or other predictive methods. -If the user removes the missing values then the returned GSDD value -will be less than the actual GSDD. - -Truncation occurs when the start and/or end -of the time series is part way through a growing season. -If the user chooses to ignore truncation then the returned value -will be less than the actual GSDD. -By default the growing season is based on the interpretation of +By default the default values and implementation of the +growing season are based on the interpretation of Coleman and Fausch (2007) who stated that We defined the start of the growing season as the @@ -91,6 +87,11 @@ with the longest length then the candidate season with the \code{"biggest"} GSDD is selected. Conversely in the case of multiple \code{"shortest"} seasons then the candidate with the \code{"smallest"} GSDD is selected. + +Truncation occurs when the start and/or end +of the time series is part way through a growing season. +If the user chooses to ignore truncation then the returned value +will be less than the actual GSDD. } \examples{ gsdd_cf(c(rep(1, 10), rep(10, 20), rep(1, 200))) diff --git a/tests/testthat/test-gsdd-cf.R b/tests/testthat/test-gsdd-cf.R index 29ac2de..8f8f0f9 100644 --- a/tests/testthat/test-gsdd-cf.R +++ b/tests/testthat/test-gsdd-cf.R @@ -17,14 +17,14 @@ test_that("window_width must be odd", { test_that("gsdd_cf returns NA when missing summer", { x <- simulated_data$synthetic x[85:320] <- NA_real_ - expect_identical(gsdd_cf(x), NA_real_) + expect_identical(gsdd_cf(x, msgs = FALSE), NA_real_) }) test_that("vector must not contain NA values", { x <- simulated_data$synthetic random_indices <- sample(seq_along(x), 40) x[random_indices] <- NA - expect_identical(gsdd_cf(x), NA_real_) + expect_identical(gsdd_cf(x, msgs = FALSE), NA_real_) }) test_that("gsdd_cf trims missing values", { @@ -44,23 +44,23 @@ test_that("if max temp in vector is lower than start_temp the function return 0" expect_identical(output, 0) }) -test_that("if end_temp is not reached, gsdd calculated to end of vector and warning is shown", { +test_that("if end_temp is not reached, gsdd calculated to end of vector and message is provided.", { x <- simulated_data$synthetic - expect_warning(gsdd_cf(x, end_temp = -40, )) + expect_message(gsdd_cf(x, end_temp = -40), "The growing season is truncated at the start of the sequence. Returning `NA`.") }) test_that("if end_temp is reached at end of vector x, indicies do not fall off the edge", { x <- simulated_data$synthetic - gsdd <- gsdd_cf(x, end_temp = -4, quiet = TRUE, ignore_truncation = TRUE) + gsdd <- gsdd_cf(x, end_temp = -4, msgs = FALSE, ignore_truncation = TRUE) expect_equal(gsdd, 3921.63308) }) test_that("if start_temp is reached at start of vector x, indicies do not fall off the edge", { x <- simulated_data$synthetic x <- x[163:length(x)] - gsdd <- gsdd_cf(x, end_temp = 4, quiet = TRUE) + gsdd <- gsdd_cf(x, end_temp = 4, msgs = FALSE) expect_equal(gsdd, NA_real_) - gsdd <- gsdd_cf(x, end_temp = 4, quiet = TRUE, ignore_truncation = TRUE) + gsdd <- gsdd_cf(x, end_temp = 4, msgs = FALSE, ignore_truncation = TRUE) expect_equal(gsdd, 2687.98160174586) }) @@ -100,10 +100,10 @@ test_that("Gets growth period with all GSDD.", { test_that("Gets growth period with higher GSDD even though shorter period.", { x <- c(rep(10, 50), rep(0, 255), rep(20, 40)) - gsdd <- gsdd_cf(x, window_width = 3, start_temp = 9, end_temp = 9, quiet = TRUE) + gsdd <- gsdd_cf(x, window_width = 3, start_temp = 9, end_temp = 9, msgs = FALSE) expect_equal(gsdd, NA_real_) gsdd <- gsdd_cf(x, - window_width = 3, start_temp = 9, end_temp = 9, quiet = TRUE, + window_width = 3, start_temp = 9, end_temp = 9, msgs = FALSE, ignore_truncation = TRUE, pick = "biggest" ) expect_equal(gsdd, 800) @@ -111,10 +111,10 @@ test_that("Gets growth period with higher GSDD even though shorter period.", { test_that("Gets growth period longest period.", { x <- c(rep(10, 50), rep(0, 255), rep(20, 40)) - gsdd <- gsdd_cf(x, window_width = 3, start_temp = 9, end_temp = 9, quiet = TRUE) + gsdd <- gsdd_cf(x, window_width = 3, start_temp = 9, end_temp = 9, msgs = FALSE) expect_equal(gsdd, NA_real_) gsdd <- gsdd_cf(x, - window_width = 3, start_temp = 9, end_temp = 9, quiet = TRUE, + window_width = 3, start_temp = 9, end_temp = 9, msgs = FALSE, ignore_truncation = TRUE, pick = "longest" ) expect_equal(gsdd, 500) @@ -122,10 +122,10 @@ test_that("Gets growth period longest period.", { test_that("Gets growth period all gsdd.", { x <- c(rep(10, 50), rep(0, 255), rep(20, 40)) - gsdd <- gsdd_cf(x, window_width = 3, start_temp = 9, end_temp = 9, quiet = TRUE) + gsdd <- gsdd_cf(x, window_width = 3, start_temp = 9, end_temp = 9, msgs = FALSE) expect_equal(gsdd, NA_real_) gsdd <- gsdd_cf(x, - window_width = 3, start_temp = 9, end_temp = 9, quiet = TRUE, + window_width = 3, start_temp = 9, end_temp = 9, msgs = FALSE, ignore_truncation = TRUE, pick = "all" ) expect_equal(gsdd, 1300) @@ -133,10 +133,10 @@ test_that("Gets growth period all gsdd.", { test_that("Gets growth period shortest", { x <- c(rep(10, 50), rep(0, 255), rep(20, 40)) - gsdd <- gsdd_cf(x, window_width = 3, start_temp = 9, end_temp = 9, quiet = TRUE) + gsdd <- gsdd_cf(x, window_width = 3, start_temp = 9, end_temp = 9, msgs = FALSE) expect_equal(gsdd, NA_real_) gsdd <- gsdd_cf(x, - window_width = 3, start_temp = 9, end_temp = 9, quiet = TRUE, + window_width = 3, start_temp = 9, end_temp = 9, msgs = FALSE, ignore_truncation = TRUE, pick = "shortest" ) expect_equal(gsdd, 800) @@ -144,19 +144,19 @@ test_that("Gets growth period shortest", { test_that("Gets growth period longest", { x <- c(rep(10, 50), rep(0, 255), rep(20, 40)) - gsdd <- gsdd_cf(x, window_width = 3, start_temp = 9, end_temp = 9, quiet = TRUE) + gsdd <- gsdd_cf(x, window_width = 3, start_temp = 9, end_temp = 9, msgs = FALSE) expect_equal(gsdd, NA_real_) gsdd <- gsdd_cf(x, - window_width = 3, start_temp = 9, end_temp = 9, quiet = TRUE, + window_width = 3, start_temp = 9, end_temp = 9, msgs = FALSE, ignore_truncation = TRUE, pick = "longest" ) expect_equal(gsdd, 500) }) -test_that("Gets growth gives warnings with truncation.", { +test_that("Gets growth gives messages with truncation.", { x <- c(rep(10, 50), rep(0, 255), rep(20, 40)) - expect_warning(expect_identical(gsdd_cf(x), NA_real_), "Growing season truncated\\.") - expect_warning(expect_identical(gsdd_cf(x, ignore_truncation = "start"), NA_real_), "Growing season truncated\\.") + expect_message(expect_identical(gsdd_cf(x), NA_real_), "The growing season is truncated at the end of the sequence. Returning `NA`.") + expect_message(expect_identical(gsdd_cf(x, ignore_truncation = "start"), NA_real_), "The growing season is truncated at the start of the sequence. Returning `NA`.") }) test_that("Gets gsdd with single boiling day.", { @@ -203,17 +203,17 @@ test_that("Gets with two weeks and 3 day window and smaller", { test_that("Gets one week with end day after of 0", { x <- c(rep(0, 180), rep(5.1, 7), rep(1, 0)) - expect_equal(gsdd_cf(x, ignore_truncation = "end", quiet = TRUE), 5.1 * 7) + expect_equal(gsdd_cf(x, ignore_truncation = "end", msgs = FALSE), 5.1 * 7) }) test_that("Gets one week with end day after of 1", { x <- c(rep(0, 180), rep(5.1, 7), rep(1, 1)) - expect_equal(gsdd_cf(x, ignore_truncation = "end", quiet = TRUE), 5.1 * 7 + 1) + expect_equal(gsdd_cf(x, ignore_truncation = "end", msgs = FALSE), 5.1 * 7 + 1) }) test_that("Gets with two weeks and 3 day window and smaller", { x <- c(rep(0, 180), rep(5.1, 7)) - expect_equal(gsdd_cf(x, ignore_truncation = "end", quiet = TRUE), 5.1 * 7) + expect_equal(gsdd_cf(x, ignore_truncation = "end", msgs = FALSE), 5.1 * 7) }) test_that("Gets triangle", { @@ -304,8 +304,8 @@ test_that("Right truncated triangle", { tibble::tibble(index = 1:length(x), x = x, ma = ma) }) - expect_equal(gsdd_cf(x, quiet = TRUE), NA_real_) - expect_equal(gsdd_cf(x, ignore_truncation = "end", quiet = TRUE), sum(x[15:length(x)])) + expect_equal(gsdd_cf(x, msgs = FALSE), NA_real_) + expect_equal(gsdd_cf(x, ignore_truncation = "end", msgs = FALSE), sum(x[15:length(x)])) }) test_that("Left truncated triangle", { @@ -320,20 +320,20 @@ test_that("Left truncated triangle", { tibble::tibble(index = 1:length(x), x = x, ma = ma) }) - expect_equal(gsdd_cf(x, quiet = TRUE), NA_real_) - expect_equal(gsdd_cf(x, ignore_truncation = "start", quiet = TRUE), sum(x[0:25])) + expect_equal(gsdd_cf(x, msgs = FALSE), NA_real_) + expect_equal(gsdd_cf(x, ignore_truncation = "start", msgs = FALSE), sum(x[0:25])) }) test_that("NA if less than 184 values after trimming trailing NAs", { x <- c(rep(1,183), rep(NA,100)) - expect_identical(gsdd_cf(x),NA_real_) + expect_message(expect_identical(gsdd_cf(x),NA_real_), "The length of the longest non-missing sequence in `x` must be at least 184. Returning `NA`.") x <- c(rep(1,184), rep(NA,100)) expect_identical(gsdd_cf(x),0) }) test_that("extracts longest non-missing sequence (not just trim tails)", { x <- c(NA,1,NA,rep(1,183),NA,1,NA) - expect_identical(gsdd_cf(x),NA_real_) + expect_identical(gsdd_cf(x, msgs = FALSE),NA_real_) x <- c(NA,1,NA,rep(1,184),NA,1,NA) expect_identical(gsdd_cf(x),0) })