R/day5.R

In Kinekenneth48/rdailychange: Daily Change Method for Spatial Data

#' @title middle_negative_test2
#' @param dx A sequential change of SWE values. This is a vector object.
#' @description For the D4 Method, we need to have five consecutive changes,
#' the ends of which are positive, and at most one of the three middles is
#' negative. This function takes the changes and returns a logical vector of
#' TRUEs when at most one of the three middles is negative.
#' @examples
#' x <- sample(-20:20)
#' rdailychange:::middle_negative_test2(x)
middle_negative_test2 <- function(dx) {
  negs <- (dx[2:(length(dx) - 3)] < 0) + # First middle < 0 PLUS
    (dx[3:(length(dx) - 2)] < 0) + # Second middle < 0 PLUS
    (dx[4:(length(dx) - 1)] < 0) # Third middle < 0
  return(negs <= 1) # Only first, second, or third middle can be < 0.
}

#' @title d5_method_from_vector
#' @param x A sequential change of SWE values. This is a vector object.
#' @description This function will take raw observations, make sure there is
#' enough data to perform the D5 Method (if not, it will return NULL), and then
#' calculate the D5 Method.
#' @examples
#' x <- sample(-15:30)
#' rdailychange:::d5_method_from_vector(x)
#'
d5_method_from_vector <- function(x) {
  n <- 5
  if (length(x) < n) {
    return(NULL)
  }

  x <- append(0, x) # made change
  dx <- x[-1] - x[-length(x)]
  d5_cands <- (dx[1:(length(dx) - (n - 1))] > 0 & dx[n:length(dx)] > 0) &
    middle_negative_test2(dx)
  result <- calc_d5_method(d5_cands, dx)
  result <- unlist(result) # made change
  result <- result[!(is.na(result))]
  return(result)
}

#' @ title Calculate D5 Method for Snow Loads
#' @description Given a dataframe, a column of which includes snow
#' observations, this function will calculate the D4 Method.
#' @param df The dataframe containing snow observations.
#' @param col_name Character string of the column name containing the
#'   snow observations.
#' @return A list of numeric vectors containing the observations
#'   for the D5 Method (list split across 2 or more raw observations of 0).
#' @examples
#' ID <- rep("USW00023062", 13)
#' NAME <- rep("DENVER-STAPLETON", 13)
#' STATE <- rep("CO", 13)
#' LATITUDE <- rep(39.7633, 13)
#' LONGITUDE <- rep(-104.8694, 13)
#' DATE <- c(1950-11-08, 1950-11-09, 1950-11-10, 1950-11-11, 1950-11-12,
#'           1950-11-13, 1950-12-05, 1950-12-06, 1950-12-07, 1950-12-08,
#'           1951-01-06, 1951-01-07, 1951-01-08)
#' SWE <- c(22.553862, 29.897561, 15.685390, 11.953282, 8.247274, 4.224420,
#'          13.676186, 13.737334, 9.453138, 4.829772, 20.319270, 10.564117,
#'       10.595503)
#' sample_data <- data.frame(ID, NAME, STATE, LATITUDE, LONGITUDE, DATE, SWE)
#' rdailychange:::d5_method(sample_data, col_name = "SWE")
#'
d5_method <- function(df, col_name = "SWE") {
  x <- df[[col_name]]
  split_observations <- split_across_n_m(x)
  result <- lapply(split_observations, d5_method_from_vector)
  return(result)
}

#' @title Extract Day-5 method observations
#' @description This function allows the user to extract sequential daily
#' changes (Day-1 method) in SWE.
#' @param station_data A data table of a measurement location/station.
#' @param col_name Character string of the column name containing the
#'   snow observations.
#' @return A list with two elements. The first element is the Day-5
#' method observations, while the second element is the annual maximum load
#' for each snow year.
#' @examples
#' sample_data <- rdailychange::sample_data
#' sample_data <- sample_data[ID == "USW00023062"]
#' rdailychange:::day5(sample_data, col_name = "SWE")
#'
day5 <- function(station_data, col_name) {

  # set data frame as data.table
  station_data <- data.table::setDT(station_data)


  # deep copy main_matrix to avoid modification by reference
  annual <- data.table::copy(station_data)


  # get station meta data
  ID <- unique(station_data$ID)
  NAME <- unique(station_data$NAME)
  STATE <- unique(station_data$STATE)
  LONGITUDE <- unique(station_data$LONGITUDE)
  LATITUDE <- unique(station_data$LATITUDE)


  DIFF <- d5_method(station_data, col_name)


  d5 <- data.table(ID, NAME, STATE, LONGITUDE, LATITUDE, DIFF)

  # modification by reference
  annual[, MONTH := as.numeric(format(as.Date(DATE), "%m"))]
  annual[, YEAR := as.numeric(format(as.Date(DATE), "%Y"))]
  annual[, YEAR := ifelse(MONTH > 07, YEAR + 1, YEAR)]


  annual <- annual[, .SD[, max(SWE)], by = .(
    ID, NAME, STATE, LONGITUDE,
    LATITUDE, YEAR
  )][, ANNUAL := V1][, V1 := NULL]

  output <- list("d5" = d5, "annual" = annual)
  return(output)
}