R/applyHeatwaves.R

Defines functions apply_hw_projections apply_all_models

Documented in apply_all_models apply_hw_projections

#' Apply a function across heat waves from all projections
#'
#' This function will take a user-specified function and apply it across
#' all the extreme event files created by \code{\link{gen_hw_set}}.
#' It will generate either a single value for every ensemble member within
#' every climate model, if \code{city_specific} is set to \code{FALSE}, or
#' a value for every city for every ensemble member, if
#' \code{city_specific} is set to \code{TRUE}.
#'
#' @param out Character string with pathname to which extreme event files were
#'    written by \code{\link{gen_hw_set}}. Typically, this will be the same
#'    pathname as that specified with \code{out} when running
#'    \code{\link{gen_hw_set}}.
#' @param FUN A character string with the name of a function to apply to
#'    the extreme event dataframes located in the directory specified by
#'    \code{out}. This function must take the argument, \code{hw_datafr},
#'    a dataframe of identified and characterized extreme events, as generated by
#'    \code{\link{gen_hw_set}}. For an example of one of these dataframes, load
#'    the \code{\link{hw_datafr}} data. The function should output a single
#'    value when applied to the full extreme event dataframe. The function can
#'    also have other arguments, which are passed through the \code{...}
#'    argument of \code{apply_all_models}.
#' @param city_specific TRUE or FALSE, specifying whether the function should
#'    be applied separately for each study location.
#' @param ... Optional arguments to \code{FUN}.
#'
#' @return A dataframe with the value output by the \code{FUN} function, as
#'    applied to all the extreme event dataframes generated by \code{gen_hw_set}.
#'
#' @note The function input as \code{FUN} must follow a very specific
#'    structure. It most have as an argument a dataframe with characterized
#'    extreme events, as generated by the \code{\link{gen_hw_set}} function.
#'    See the \code{futureheatwaves} vignette for more guidance on creating and
#'    applying a custom function to explore the extreme events identified and
#'    characterized by \code{\link{gen_hw_set}}.
#'
#' @examples
#' ex_results <- system.file("extdata/example_results",
#'                           package = "futureheatwaves")
#' apply_all_models(ex_results, FUN = average_mean_temp)
#' apply_all_models(ex_results, FUN = average_mean_temp,
#'                  city_specific = TRUE)
#'
#' @export
apply_all_models <- function(out, FUN, city_specific = FALSE, ...){

        proj_files <- list.files(paste(out, "Heatwaves", sep = "/"),
                                 recursive = TRUE, full.names = TRUE)

        result_list <- lapply(proj_files,
                              apply_hw_projections,
                              FUN,
                              city_specific,
                              ...)
        result_df <- do.call(rbind.data.frame, result_list)

        return(result_df)
}

#' Apply a function to projected extreme events
#'
#' This function takes a user-specified function and applies is to a
#' single file of extreme event projections, as specified by \code{hwPath}.
#' It will generate either a single value for every ensemble member, if
#' \code{city_specific} is set to \code{FALSE}, or a value for every city, if
#' \code{city_specific} is set to \code{TRUE}.
#'
#' @param FUN A character string giving the name of a function to apply to
#'    the extreme event dataframe in the file specified by \code{hwPath}.
#'    This function must only take one argument, \code{hw_datafr}, which
#'    identifies a dataframe as generated by \code{\link{gen_hw_set}}. The
#'    function should output a single value (e.g., average heat wave length)
#'    when applied to the full dataframe.
#' @param hwPath A filepath to a comma-separated (.csv) file with a dataset
#'    of extreme events and their characteristics, as generated by
#'    \code{\link{gen_hw_set}}. The file at the specified filepath must
#'    conform exactly to the format of the extreme event files created by
#'    \code{\link{gen_hw_set}}.
#' @inheritParams apply_all_models
#'
#' @note The function input as \code{FUN} must follow a very specific
#'    structure. It most have only one argument, and that argument
#'    must be a dataframe with extreme events and their characteristics, as
#'    generated by the \code{\link{gen_hw_set}} function. See the
#'    \code{futureheatwaves} vignette for more guidance on creating and
#'    applying a custom function to explore the extreme events identified and
#'    characterized by \code{\link{gen_hw_set}}.
#'
#' @importFrom dplyr %>%
apply_hw_projections <- function(hwPath, FUN, city_specific = FALSE, ...){

        arguments <- list(...)

        hwPathSplit <- unlist(strsplit(hwPath, split = "/"))
        modelName <- hwPathSplit[(length(hwPathSplit) - 1)]
        ensembleName <- sub(".csv", "", hwPathSplit[length(hwPathSplit)])

        hw_datafr <- utils::read.csv(hwPath, as.is = TRUE) %>%
                dplyr::mutate_(city = ~ factor(city),
                       start.date = ~ as.Date(start.date),
                       end.date = ~ as.Date(end.date))

        if(!city_specific){
                arguments$hw_datafr <- hw_datafr
                hw_fun_out <- do.call(FUN, arguments)
                hw_fun_out <- data.frame(model = modelName,
                                         ensemble = ensembleName,
                                         value = hw_fun_out)
        } else {
                cities <- levels(hw_datafr$city)
                hw_fun_out <- data.frame(model = modelName,
                                         ensemble = ensembleName,
                                         city = cities,
                                         value = NA)
                for(i in 1:length(cities)){
                        hw_datafr_city <- dplyr::filter_(hw_datafr,
                                                        ~ city == cities[i])
                        arguments$hw_datafr <- hw_datafr_city
                        hw_fun_out$value[i] <- do.call(FUN, arguments)
                }
        }
        return(hw_fun_out)
}
geanders/futureheatwaves documentation built on June 5, 2017, 9:05 a.m.