Nothing
#' Compute the prediction interval summary over time.
#'
#' @param x data frame
#' @param output variable to show, character value
#' @param scenarios scenarios, character vector, NULL is default
#' @param level PI level, default is 0.9 (90\% PI)
#' @param gather FALSE: med, low & up columns, TRUE: metric column
#' @return a summary table
#' @importFrom dplyr across all_of group_by_at mutate rename_at summarise
#' @importFrom tidyr pivot_longer
#' @importFrom stats median quantile
#' @export
PI <- function(x, output, scenarios=NULL, level=0.90, gather=TRUE) {
assertthat::assert_that(is.character(output) && length(output)==1)
retValue <- x %>% dplyr::rename_at(.vars=output, .funs=~"variable_") %>%
dplyr::group_by_at(c("TIME", scenarios)) %>%
dplyr::summarise(
med=stats::median(.data$variable_),
low=stats::quantile(.data$variable_, (1-level)/2),
up=stats::quantile(.data$variable_, 1-(1-level)/2),
.groups="keep"
)
# Gather data if requested
if (gather) {
# Remove attributes in columns low, med, up (5%, 95%, coming from the quantile method)
# This causes warnings
retValue <- retValue %>% dplyr::mutate(dplyr::across(c("low", "med", "up"), as.vector))
retValue <- retValue %>% tidyr::pivot_longer(-dplyr::all_of(c("TIME", scenarios)), names_to="metric", values_to="value")
}
return(retValue)
}
#' Compute the VPC summary. Input data frame must contain the following columns:
#' - replicate: replicate number
#' - low: low percentile value in replicate (and in scenario if present)
#' - med: median value in replicate (and in scenario if present)
#' - up: up percentile value in replicate (and in scenario if present)
#' - any scenario column
#'
#' @param x data frame
#' @param scenarios scenarios, character vector, NULL is default
#' @param level PI level, default is 0.9 (90\% PI)
#' @importFrom tidyr pivot_wider
#' @return VPC summary with columns TIME, <scenarios> and all combinations of
#' low, med, up (i.e. low_low, low_med, low_up, etc.)
#' @export
VPC <- function(x, scenarios=NULL, level=0.90) {
retValue <- PI(x=x, output="value", scenarios=c("metric", scenarios), level=level, gather=FALSE)
retValue_ <- retValue %>%
tidyr::pivot_wider(names_from="metric",
names_glue="{metric}_{.value}",
values_from=c("low", "med", "up"))
return(retValue_)
}
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.