transfer over

DESCRIPTION

@@ -27,5 +27,13 @@ Config/testthat/edition: 3
 Depends: 
     R (>= 4.1)
 LazyData: true
-VignetteBuilder: knitr
-
+Imports: 
+    chk,
+    dplyr,
+    dttr2,
+    purrr,
+    rlang,
+    stringr,
+    tibble,
+    tidyr,
+    zoo

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2024
+COPYRIGHT HOLDER: Teck Coal Ltd.

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2024 Teck Coal Ltd.
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -1,2 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
+export(gdd_cf_data)
+export(gsdd_cf)
+export(gsdd_cf_data)
+export(gss_cf_data)
+import(chk)
+importFrom(rlang,.data)
+importFrom(tibble,tibble)

R/data.R

@@ -0,0 +1,27 @@
+# Copyright 2023 Province of Alberta
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+#' Sample Data for GSDD Calculation Demonstration
+#'
+#' The data is a synthetic time series of daily temperature data for the year
+#' 2019.
+#'
+#' @format A tibble with columns:
+#' \describe{
+#' \item{Date}{date for each calendar year}
+#' \item{synthetic}{synthetic yearly temperature data for demonstration and
+#' testing}
+#' }
+#'
+"simulated_data"

R/gdd-cf-data.R

@@ -0,0 +1,57 @@
+#' Calculate Growing Degree Days (GDD) from a Data Frame
+#' 
+#' The GDD which is a the growing degree days to the end date 
+#' is calculated for each study year from a data frame. 
+#' with `date` and `temperature` columns. 
+#' `date`, which must be of class Date provides the dates and 
+#' `temperature` which must be a numeric vector provides the 
+#' mean daily water temperature in degrees centigrade.
+#'
+#' @param x A data frame with two columns `date` and `temperature`. 
+#' @param start_date A Date scalar of the first date within each year to consider (the year
+#' is ignored).
+#' @param end_date A Date scalar of the end date for the growing degree days
+#'  (the year is ignored).
+#' If `end_date` is less than `start_date` (ignoring the year) then the window is considered 
+#' to span two calendar years.
+#' @inheritParams gsdd_cf
+#' @param ignore_truncation A flag specifying whether to ignore start truncation (end truncation is always ignored).
+#' @return A tibble with two columns `year` and `gdd`.
+#' `year`, which is an integer vector, indicates the year in which the window
+#' began and `gdd` which is a non-negative real number provides the GSDD
+#' or a missing value if it cannot be calculated.
+#' @seealso [gsdd_cf_data()]
+#' @export
+#'
+#' @examples
+#' data <- gsdd::simulated_data
+#' data$temperature <- data$synthetic
+#' gdd_cf_data(data)
+gdd_cf_data <- function(
+    x, 
+    start_date = as.Date("1972-01-01"), 
+    end_date = as.Date("1972-09-30"),
+    ignore_truncation = FALSE,
+    start_temp = 5,
+    end_temp = 4,
+    window_width = 7,
+    pick = "longest",
+    msgs = TRUE) {
+
+  chk_flag(ignore_truncation)
+
+  if(!ignore_truncation) {
+    ignore_truncation <- "end"
+  }
+
+  .gsdd_data(
+    x, 
+    start_date, 
+    end_date, 
+    ignore_truncation = ignore_truncation, 
+    msgs = msgs,
+    start_temp = start_temp,
+    end_temp = end_temp,
+    window_width = window_width) |>
+    dplyr::rename(gdd = "gsdd")
+}

R/gsdd-cf-data.R

@@ -0,0 +1,41 @@
+#' Calculate Growing Season Degree Days (GSDD) from a Data Frame
+#' 
+#' The GSDD is calculated for each study year from a data frame 
+#' with `date` and `temperature` columns. 
+#' `date`, which must be of class Date provides the dates and 
+#' `temperature` which must be a numeric vector provides the 
+#' mean daily water temperature in degrees centigrade. For additional information on 
+#' GSDD and the various arguments that can be passed via `...` see [`gsdd_cf()`].
+#'
+#' @param x A data frame with two columns `date` and `temperature`. 
+#' @param start_date A Date scalar of the first date within each year to consider (the year
+#' is ignored).
+#' @param end_date A Date scalar of the last date within each year to consider (the year is ignored).
+#' If `end_date` is less than `start_date` (ignoring the year) then the window is considered 
+#' to span two calendar years.
+#' @inheritParams gsdd_cf
+#' @param ... Additional arguments passed to [`gsdd_cf()`].
+#' @return A tibble with two columns `year` and `gsdd`.
+#' `year`, which is an integer vector, indicates the year in which the window
+#' began and `gsdd` which is a non-negative real number provides the GSDD
+#' or a missing value if it cannot be calculated.
+#' @seealso [gsdd_cf()] and [gdd_cf_data()]
+#' @export
+#'
+#' @examples
+#' data <- gsdd::simulated_data
+#' data$temperature <- data$synthetic
+#' gsdd_cf_data(data)
+gsdd_cf_data <- function(
+    x, 
+    start_date = as.Date("1972-01-01"), 
+    end_date = as.Date("1972-12-31"), 
+    ignore_truncation = FALSE,
+    msgs = TRUE, 
+    ...) {
+
+  .gsdd_data(x, start_date = start_date, end_date = end_date, 
+             ignore_truncation = ignore_truncation,
+             msgs = msgs,
+             ...)
+}

R/gsdd-cf.R

@@ -0,0 +1,99 @@
+#' Calculate Growing Season Degree Days (GSDD) from a vector
+#'
+#' Growing Season Degree Days (GSDD) is a water temperature metric
+#' 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).
+#' 
+#' The GSDD is calculated across the longest consecutive sequence of non-missing
+#' values which must be at least twice the window width in length otherwise a 
+#' missing value is returned.
+#' If the vector includes missing values it is recommended that they are
+#' replaced by estimates of the actual values.
+#'
+#' 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
+#' beginning of the first week that average stream temperatures exceeded and
+#' remained above 5C for the season;
+#' the end of the growing season was defined as
+#' the last day of the first week that
+#' average stream temperature dropped below 4C.
+#'
+#' For the purposes of the calculation week is assumed to refer to a seven day
+#' rolling average as opposed to the calendar week.
+#' 
+#' If there are multiple growing 'seasons' within the same year then by
+#' default the returned value is the sum of the GSDD values for `"all"` seasons.
+#' 
+#' The user also has the option to pick the `"first"`/`"last"` or
+#'  `"longest"`/`"shortest"` season or the season with 
+#'  the `"biggest"`/`"smallest"` GSDD.
+#'  If the user picks the `"longest"` season but there are multiple seasons
+#' with the longest length then the candidate 
+#' 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
+#' of interest in C. It must be consist of no more than 
+#' 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" (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
+#' at the end of the growing season in C. It must be greater than or equal to
+#' the start temperature.
+#' @param window_width A positive whole number of the
+#' width of the rolling mean window in days. By default 7.
+#' @param pick A string specifying whether to pick the
+#' "longest", "shortest", "first" or "last" 'season' or the season with the
+#' "biggest" or "smallest" GSDD. By default the returned value is the
+#' the GSDD value for the "longest" 'season'.
+#' @param msgs A flag specifying whether to provide messages.
+#' @seealso [`gsdd_cf_data()`]
+#' @return A non-negative real number of the GSDD.
+#' @export
+#'
+#' @examples
+#' gsdd_cf(c(rep(1, 10), rep(10, 20), rep(1, 200)))
+#' gsdd_cf(gsdd::simulated_data$synthetic)
+gsdd_cf <- function(x,
+                    ignore_truncation = FALSE,
+                    start_temp = 5,
+                    end_temp = 4,
+                    window_width = 7,
+                    pick = "longest",
+                    msgs = TRUE) {
+
+  chk_string(pick)
+  chk_subset(
+    pick, 
+    c("biggest", "smallest", "longest", "shortest", "first", "last", "all"))
+
+  data <- .gss(x, ignore_truncation = ignore_truncation, 
+              start_temp = start_temp, end_temp = end_temp,
+              window_width = window_width, msgs = msgs)
+
+  if(vld_scalar(data)) {
+    return(data)
+  }
+  data <- data |> 
+    pick_season(pick)
+
+  sum(data$gsdd)
+}

R/gsdd-package.R

@@ -2,5 +2,8 @@
 "_PACKAGE"
 
 ## usethis namespace: start
+#' @import chk
+#' @importFrom tibble tibble
+#' @importFrom rlang .data
 ## usethis namespace: end
 NULL

R/gss-cf-data.R

@@ -0,0 +1,26 @@
+#' Calculate Growing Seasons from a Data Frame
+#' 
+#'
+#' @inheritParams gsdd_cf
+#' @inheritParams gsdd_cf_data
+#' @return A tibble with four columns `year`, `start_dayte`, `end_dayte` and `gsdd`.
+#' @seealso [gsdd_cf_data()]
+#' @export
+#'
+#' @examples
+#' data <- gsdd::simulated_data
+#' data$temperature <- data$synthetic
+#' gss_cf_data(data)
+gss_cf_data <- function(
+    x, 
+    start_date = as.Date("1972-01-01"), 
+    end_date = as.Date("1972-12-31"), 
+    ignore_truncation = FALSE,
+    msgs = TRUE, 
+    ...) {
+
+  .gsdd_data(x, start_date = start_date, end_date = end_date, 
+             ignore_truncation = ignore_truncation,
+             msgs = msgs,
+             ..., gss = TRUE)
+}

R/gss-cf.R

@@ -0,0 +1,19 @@
+gss_cf <- function(x,
+                   ignore_truncation = FALSE,
+                   start_temp = 5,
+                   end_temp = 4,
+                   window_width = 7,
+                   msgs = TRUE) {
+  data <- .gss(x, ignore_truncation = ignore_truncation, 
+               start_temp = start_temp, end_temp = end_temp,
+               window_width = window_width, msgs = msgs)
+
+  if(vld_scalar(data)) {
+    return(tibble::tibble(start_index = integer(0), end_index = integer(0), gsdd = numeric(0)))
+  }
+  data |>
+    dplyr::select(start_index = "index_start",
+                  end_index = "index_end",
+                  "gsdd") |>
+    dplyr::arrange(.data$start_index)
+}