Nothing
#' 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)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.