R/IDHeatwaves.R

In geanders/futureheatwaves: Find, Characterize, and Explore Extreme Events in Climate Projections

#' Identify all heat waves in a time series
#'
#' This function takes a dataframe with columns for date and projected
#' temperature and adds columns identifying which days belong to a
#' heat wave and giving separate numbers to identify each discrete heat wave.
#'
#' @param threshold Numeric string with threshold temperature used in
#'    the heat wave definition, in degrees Fahrenheit.
#' @param datafr A dataframe with daily temperature projections in the
#'    the city being processed. This dataframe must have two columns:
#'    (1) the first column must have the date of each observation, with
#'    class "Date" and; (2) the second column must have temperatures
#'    in degrees Fahrenheit. In the normal running of this package, this
#'    dataframe will be generated by the closure created by
#'    \code{\link{createCityProcessor}}.
#' @inheritParams processModel
#' @inheritParams closest_point
#'
#' @return Returns the dataframe entered as \code{datafr}, but with new
#'    columns providing heat wave identifiers. The returned dataframe will
#'    have new columns for: \code{hw}: whether a day was part of a heat wave
#'    (0 : not part of a heat wave / 1: part of a heat wave); and
#'    \code{hw.number}: if it was part of a heat wave, the number of the
#'    heat wave (1, 2, etc.).
#'
#' @note The function actually used to identify heat waves in the time series
#'    is specified in the `IDheatwaves` slot of the `custom` object passed
#'    into this function. The default is the function
#'    \code{\link{IDHeatwavesCPPwrapper}}. The user can specify a different
#'    function using the argument \code{IDheatwavesFunction} in
#'    \code{\link{gen_hw_set}}.
#'
#' @export
IDheatwaves <- function(threshold, datafr, global, custom){

        hwdata <- do.call(custom["IDheatwaves"][[1]],
                          list(threshold = threshold,
                               datafr = datafr,
                               numDays = custom["numDays"][[1]]))

        return(hwdata)
}

#' Identify heat waves in a time series
#'
#' This function identifies heat waves in a time series of temperature
#' data using a heat wave definition that a heat wave must be a certain number
#' of days with temperatures equal to or above some threshold temperature.
#'
#' @inheritParams closest_point
#' @inheritParams IDheatwaves
#' @inheritParams gen_hw_set
#'
#' @return Returns the dataframe entered as \code{datafr}, but with new
#'    columns providing heat wave identifiers. The returned dataframe will
#'    have new columns for whether a day was part of a heat wave (\code{hw},
#'    0 / 1), and , if it was part of a heat wave, the number of the heat wave
#'    (\code{hw.number}).
#'
#' @note There are a few cases near the edges of data frames when this function
#'    would return that a day was not a heat wave when it was. First, if the
#'    first day of the dataset is a heat wave because preceeding days exceeded
#'    the threshold, but the second day in the dataframe is not above the
#'    threshold, this function would not capture that the first day was a
#'    heat wave. A similar caveat applies to the last day in the dataframe.
#'    In northern hemisphere studies, this should not be a concern, as it is
#'    unlikely that Jan. 1 or Dec. 31 would qualify as
#'    a heat wave. However, care should be taken
#'    when using this function either with Southern Hemisphere cities
#'    or when exploring exposures that, unlike heat waves, may occur very
#'    early or late in the calendar year.
#'
#' @examples
#' \donttest{
#' data(datafr)
#' hw_ids <- IDHeatwavesR(threshold = 80, datafr = datafr,
#'                        numDays = 3)
#' }
#'
#' @export
IDHeatwavesR <- function(threshold, datafr, numDays){

        days <- numDays

        # Add names to the dataframe
        colnames(datafr) <- c("date", "tmpd")

        # Find temperatures that exceed the threshold. One means the
        # measurement equals or exceeds threshold.
        tempsExceedingthreshold <- as.numeric(datafr[,2] >= threshold)

        # Add zero to end of vector so that the match function below
        tempsExceedingthreshold <- c(tempsExceedingthreshold, 0)

        # What a heat wave looks like in a vector
        heatwaveForm <- rep(1, days)

        # Counter for heat wave number
        counter <- 1

        # hwBound is used to extract a vector of data from the series to
        # compare against heat waveForm
        hwBound <- days - 1

        # Initialize dataframe containing the columns that will be added to datafr
        # Initialize dataframe containing the columns that will be added to
        # datafr
        hwInfo <- data.frame(hw = c(9),
                            hw.number = c(9))

        # Current Index
        i <- 1

        # Identify all heat waves for the city
        while (i <= nrow(datafr)) {
                # Check if there is a heat wave starting at i
                # If so, acquire size of heat wave
                if(identical(tempsExceedingthreshold[i: (i + hwBound)],
                              heatwaveForm)){
                        size <- match(0, tempsExceedingthreshold[-(1:i)])

                        # Store all desired information about this heat wave
                        hwInfo <- data.frame(hw = c(hwInfo[,1], rep(1, size)),
                                             hw.number = c(hwInfo[,2],
                                                           rep(counter, size)))

                        # Increment and advance
                        counter <- counter + 1
                        i <- i + size
                } else {
                        # If no heat wave at i, then add zeros to the end of
                        # the dataframe
                        hwInfo <- rbind(hwInfo, c(0, 0))
                        i <- i + 1
                }
        }

        # Combine the original dataframe with the heat wave characteristics
        # matrix. Notice the placeholder row is excluded.
        return(data.frame(datafr, hwInfo[-1,]))
}

#' Identify heat waves in a time series
#'
#' This function identifies heat waves in a time series of temperature
#' data using a heat wave definition that a heat wave must be a certain
#' number of days above the greater of either a given threshold or
#' 80 degrees Fahrenheit.
#'
#' @inheritParams closest_point
#' @inheritParams IDheatwaves
#' @inheritParams gen_hw_set
#'
#' @return Returns the dataframe entered as \code{datafr}, but with new
#'    columns providing heat wave identifiers. The returned dataframe will
#'    have new columns for whether a day was part of a heat wave (\code{hw},
#'    0 / 1), and if it was part of a heat wave, the number of the heat wave
#'    (\code{hw.number}).
#'
#' @note There are a few cases near the edges of data frames when this function
#'    would return that a day was not a heat wave when it was. First, if the
#'    first day of the dataset is a heat wave because preceeding days exceeded
#'    the threshold, but the second day in the dataframe is not above the
#'    threshold, this function would not capture that the first day was a
#'    heat wave. A similar caveat applies to the last day in the dataframe.
#'    In northern hemisphere studies, this should not be a concern, as it is
#'    unlikely that Jan. 1 or Dec. 31 would qualify as
#'    a heat wave. However, care should be taken
#'    when using this function either with Southern Hemisphere cities
#'    or when exploring exposures that, unlike heat waves, may occur very
#'    early or late in the calendar year.
#'
#' @examples
#' \donttest{
#' data(datafr)
#' hw_ids <- IDHeatwavesAlternative(threshold = 80, datafr = datafr,
#'                                  numDays = 3)
#' }
#'
#' @export
IDHeatwavesAlternative <- function(threshold, datafr, numDays){

        days <- numDays
        if(threshold <= 80){
                threshold <- 80
        }

        # Add names to the dataframe
        colnames(datafr) <- c("date", "tmpd")

        # Find temperatures that exceed the threshold. One means the
        # measurement equals or exceeds threshold.
        tempsExceedingthreshold <- as.numeric(datafr[,2] >= threshold)

        # Add zero to end of vector so that the match function below
        tempsExceedingthreshold <- c(tempsExceedingthreshold, 0)

        # What a heat wave looks like in a vector
        heatwaveForm <- rep(1, days)

        # Counter for heat wave number
        counter <- 1

        # hwBound is used to extract a vector of data from the series to
        # compare against heat waveForm
        hwBound <- days - 1

        # Initialize dataframe containing the columns that will be added to
        # datafr
        hwInfo <- data.frame(hw = c(9),
                             hw.number = c(9))

        # Current Index
        i <- 1

        # Identify all heat waves for the city
        while (i <= length(datafr[ , 2])) {
                # Check if there is a heat wave starting at i
                if(identical(tempsExceedingthreshold[i: (i + hwBound)],
                              heatwaveForm)){
                        # Acquire size of heat wave
                        size <- match(0, tempsExceedingthreshold[-(1:i)])

                        # Store all desired information about this heat wave
                        hwInfo <- data.frame(hw = c(hwInfo[,1], rep(1, size)),
                                             hw.number = c(hwInfo[,2],
                                                           rep(counter, size)))

                        # Increment counter for heat wave number
                        # Advance i to next position after heat wave
                        counter <- counter + 1
                        i <- i + size
                } else {
                        # If no heat wave at i, then add zeros to the end of the
                        # dataframe
                        hwInfo <- rbind(hwInfo, c(0, 0))
                        i <- i + 1
                }
        }

        # Combine the original dataframe with the heat wave characteristics
        # matrix. Notice the placeholder row is excluded.
        return(data.frame(datafr, hwInfo[-1, ]))
}

#' Identify heat waves in a time series
#'
#' This function identifies heat waves in a time series of temperature
#' data using a heat wave definition that a heat wave must be a certain number
#' of days with temperatures equal to or above some threshold temperature. This
#' function uses a compiled C++ function for part of the process, making it
#' faster than the R analogue, \code{\link{IDHeatwavesR}}, although the two
#' functions give identical results.
#'
#' This function is the default function used to identify heat waves in
#' \code{\link{gen_hw_set}}.
#'
#' @inheritParams closest_point
#' @inheritParams IDheatwaves
#' @inheritParams gen_hw_set
#'
#' @return Returns the dataframe entered as \code{datafr}, but with new
#'    columns providing heat wave identifiers. The returned dataframe will
#'    have new columns for whether a day was part of a heat wave (\code{hw},
#'    0 / 1), and, if it was part of a heat wave, the number of the heat wave
#'    (\code{hw.number}).
#'
#' @note There are a few cases near the edges of data frames when this function
#'    would return that a day was not a heat wave when it was. First, if the
#'    first day of the dataset is a heat wave because preceeding days exceeded
#'    the threshold, but the second day in the dataframe is not above the
#'    threshold, this function would not capture that the first day was a
#'    heat wave. A similar caveat applies to the last day in the dataframe.
#'    In northern hemisphere studies, this should not be a concern, as it is
#'    unlikely that Jan. 1 or Dec. 31 would qualify as
#'    a heat wave. However, care should be taken
#'    when using this function either with Southern Hemisphere cities
#'    or when exploring exposures that, unlike heat waves, may occur very
#'    early or late in the calendar year.
#'
#' @examples
#' data(datafr)
#' hw_ids <- IDHeatwavesCPPwrapper(threshold = 80, datafr = datafr,
#'                                 numDays = 3)
#'
#' @export
IDHeatwavesCPPwrapper <- function(datafr, threshold, numDays){
        colnames(datafr) <- c("date", "tmpd")
        numDays <- as.integer(numDays)

        # Find temperatures that exceed the threshold. One means the
        # measurement equals or exceeds threshold.
        tempsExceedingthreshold <- as.numeric(datafr[ , 2] >= threshold)

        # Add zero onto the end of the vector. The CPP routine needs
        # this to work properly.
        tempsExceedingthreshold <- c(tempsExceedingthreshold, 0)

        # Identify heat waves using the C++ functions.
        heatwaves <- IDHeatwavesCPP(heatwaveLength = numDays,
                                    tempsExceedingCutoff = tempsExceedingthreshold)

        # Attach heat waves columns onto the data in the datafr
        # variable. Note that the final row, which contains zeroes as
        # placeholders, is excluded.
        heatwaves <- heatwaves[-nrow(heatwaves), ]
        heatwaves <- cbind(datafr, heatwaves)
        colnames(heatwaves) <- c("date", "tmpd", "hw", "hw.number")

        return(heatwaves)
}