R/plot_cashflow.R

In decisionSupport: Quantitative Support of Decision Making under Uncertainty

#' Cashflow plot for Monte Carlo simulation results
#' 
#' Creates a cashflow plot of the returned list of related outputs from the \code{\link[decisionSupport:mcSimulation]{mcSimulation}} function using \code{\link{ggplot2}}
#' 
#' @author Eduardo Fernandez (\email{efernand@@uni-bonn.de})
#' @author Cory Whitney (\email{cory.whitney@@uni-bonn.de})
#' 
#' @param mcSimulation_object is a data frame of Monte Carlo simulations of cashflow outputs (in wide format, see example). Usually the "mcSimulation_object.csv" file generated by \code{\link[decisionSupport:mcSimulation]{mcSimulation}} function.
#' @param cashflow_var_name is the name (character string) for the variable name used to define cashflow in the returned list of outputs from the \code{\link[decisionSupport:mcSimulation]{mcSimulation}} function. If multiple decision options are provided this will produce a comparative panel plot.
#' @param x_axis_name is the name (character string) for the title of the timeline of the intervention to be printed on the x axis in quotes.
#' @param y_axis_name is the name (character string) for the title of the units of the cashflow to be printed on the y axis.
#' @param legend_name is the name (character string) for the title of the legend
#' @param legend_labels is the name (character string) for the labels of the legend. The default is inner, outer and median quantiles, i.e. `c("5 to 95", "25 to 75", "median")` and replacements should follow the same order
#' @param color_25_75 is the color for the shade fill of the 25-75\% quantile from the grDevices colors. The default is "grey40". 
#' @param color_5_95 is the color for the shade fill of the 5-95\% quantile from the grDevices colors. The default is "grey70". 
#' @param color_median is the color for the median line from the grDevices colors. The default is  "blue".
#' @param facet_labels are the names (character string) for the decisions. The default is the cashflow_var_name parameter.
#' @param base_size is the base text size to be used for the plot. The default is 11, this is the \code{\link[ggplot2:ggtheme]{ggplot2::ggtheme}} default
#' @param ... accepts arguments to be passed to \code{\link[ggplot2:ggtheme]{ggplot2::ggtheme}}
#' 
#' @keywords Monte-Carlo decisionSupport decision-analysis cashflow risk uncertainty
#' 
#' @details 
#' This function automatically defines quantiles (5 to 95\% and 25 to 75\%) as well as a value for the median. 
#' 
#' @return This function returns a plot of classes \code{'gg'}, 
#' and \code{'ggplot'}. This allows the user to
#' continue editing some features of the plots through the syntax 
#' \code{'+'}.
#'  
#' @references 
#' Lanzanova Denis, Cory Whitney, Keith Shepherd, and Eike Luedeling. “Improving Development Efficiency through Decision Analysis: Reservoir Protection in Burkina Faso.” Environmental Modelling & Software 115 (May 1, 2019): 164–75. \doi{10.1016/j.envsoft.2019.01.016}.
#' 
#' @examples 
#'  
#' # Plotting the cashflow:
#' 
#' # Create the estimate object (for multiple options):
#' 
#' variable = c("revenue_option1", "costs_option1", "n_years", 
#'              "revenue_option2", "costs_option2")
#' distribution = c("norm", "norm", "const", "norm", "norm")
#' lower = c(10000,  5000, 10, 8000,  500)
#' upper = c(100000, 50000, 10, 80000,  30000)
#' 
#' costBenefitEstimate <- as.estimate(variable, distribution, lower, upper)
#' 
#' # Define the model function without name for the return value:
#' 
#' profit1 <- function(x) {
#'   
#' cashflow_option1 <- vv(revenue_option1 - costs_option1, n = n_years, var_CV = 100)
#' cashflow_option2 <- vv(revenue_option2 - costs_option2, n = n_years, var_CV = 100)
#' 
#' return(list(Revenues_option1 = revenue_option1,
#'             Revenues_option2 = revenue_option2,
#'             Costs_option1 = costs_option1,
#'             Costs_option2 = costs_option2,
#'             Cashflow_option_one = cashflow_option1,
#'             Cashflow_option_two = cashflow_option2))
#' }
#' 
#' # Perform the Monte Carlo simulation:
#' 
#' predictionProfit1 <- mcSimulation(estimate = costBenefitEstimate,
#'                                   model_function = profit1,
#'                                   numberOfModelRuns = 10000,
#'                                   functionSyntax = "plainNames")
#' 
#' 
#' # Plot the cashflow distribution over time
#' 
#' plot_cashflow(mcSimulation_object = predictionProfit1, 
#'               cashflow_var_name = "Cashflow_option_one",
#'               x_axis_name = "Years with intervention",
#'               y_axis_name = "Annual cashflow in USD",
#'               color_25_75 = "green4", color_5_95 = "green1",
#'               color_median = "red")
#' 
#' ##############################################################
#' # Example 2 (Plotting the cashflow with panels for comparison):
#'
#' # Compare the cashflow distribution over time for multiple decision options  
#' 
#' plot_cashflow(mcSimulation_object = predictionProfit1, 
#'               cashflow_var_name = c("Cashflow_option_one", "Cashflow_option_two"),
#'               x_axis_name = "Years with intervention",
#'               y_axis_name = "Annual cashflow in USD",
#'               color_25_75 = "green4", color_5_95 = "green1",
#'               color_median = "red", 
#'               facet_labels = c("Option 1", "Option 2"))
#'   
#' @importFrom magrittr %>%
#' @importFrom stringr str_detect str_locate
#'   
#' @export plot_cashflow
#' 
plot_cashflow <- function(mcSimulation_object, cashflow_var_name, 
                          x_axis_name = "Timeline of intervention", 
                          y_axis_name = "Cashflow", 
                          legend_name = "Quantiles (%)",
                          legend_labels = c("5 to 95", "25 to 75", "median"),
                          color_25_75 = "grey40", 
                          color_5_95 = "grey70", 
                          color_median = "blue", 
                          facet_labels = cashflow_var_name,
                          base_size = 11,
                          ...)
  {
  
  
  # Check if mcSimulation_object is class mcSimulation
  assertthat::assert_that(class(mcSimulation_object)[[1]] == "mcSimulation",
                          msg = "mcSimulation_object is not class 'mcSimulation', please provide a valid object. This does not appear to have been generated with 'mcSimulation' function.")
  
  
  # Create a dataframe from the mcSimulation_object
  data <- data.frame(mcSimulation_object$y,
                     mcSimulation_object$x)
  
  assertthat::assert_that(is.character(cashflow_var_name),
                          msg = "cashflow_var_name is not a character string.")
  
  assertthat::assert_that(is.character(x_axis_name), msg = "x_axis_name is not a character string.")
  assertthat::assert_that(is.character(y_axis_name), msg = "y_axis_name is not a character string.")
  
  assertthat::assert_that(is.character(color_25_75), msg = "color_25_75 is not a character string.")
  assertthat::assert_that(is.character(color_5_95), msg = "color_5_95 is not a character string.")
  assertthat::assert_that(is.character(color_median), msg = "color_median is not a character string.")
  
  assertthat::assert_that(color_25_75 %in% grDevices::colors(), msg = "Please choose a color name for color_25_75 from the grDevices colors.")
  assertthat::assert_that(color_5_95 %in% grDevices::colors(), msg = "Please choose a color name for color_5_95 from the grDevices colors.")
  assertthat::assert_that(color_median %in% grDevices::colors(), msg = "Please choose a color name for color_median from the grDevices colors.")
  
  assertthat::assert_that(any(substr(names(data), 
                                     1, nchar(cashflow_var_name)) %in% cashflow_var_name), 
                          msg = "There are no variables that start with the same name as cashflow_var_name in your data.")
  
  ## Use 'complete.cases' from stats to remove NA
  if (any(is.na(data))) {
    warning(paste("Some data included \"NA\" and", 
                  table(is.na(data))[2], "rows were removed."))
    data <- data[stats::complete.cases(data), ]
  }
  
  # order the data frame
  subset_data <- data %>%
    dplyr::select(dplyr::starts_with(cashflow_var_name)) %>%
    tidyr::pivot_longer(dplyr::starts_with(cashflow_var_name)) 
  
  # create an empty list to save outputs of for loop
  subset_list <- list()
  
  # create a for loop according to the cashflow_var_name 
  # to separate the decision option and the year on the x-axis
  for(i in 1 : length(cashflow_var_name)) {

    subset_list[[i]] <- subset_data %>% 
    tidyr::separate(name, c("decision_option", "x_scale"), 
                    sep = nchar(cashflow_var_name[i])) %>%
      dplyr::filter(decision_option == cashflow_var_name[i])
  }
  
  # Bind the lists of data back together  
  subset_data <- dplyr::bind_rows(subset_list)
  
  # Check that time is more than 2 to produce a useful error
  assertthat::assert_that(all(unique(subset_data$x_scale) != ""),
                          msg = "Time scale is not greater than or equal to '2'. Consider adding more time to the model.")
  
  #define the quantiles of cashflow for each value of x_scale based on the replicates of the MC
  summary_subset_data <- suppressMessages(subset_data %>%
    dplyr::group_by(decision_option, x_scale) %>%
    dplyr::summarize(p5 = quantile(value, 0.05),
              p25 = quantile(value, 0.25),
              p50 = quantile(value, 0.50),
              p75 = quantile(value, 0.75),
              p95 = quantile(value, 0.95))) 
  
  ggplot2::ggplot(summary_subset_data, 
                  ggplot2::aes(as.numeric(x_scale))) +
    ggplot2::geom_ribbon(
      ggplot2::aes(ymin = p5, ymax = p95, fill = legend_labels[1])) +
    ggplot2::geom_ribbon(
      ggplot2::aes(ymin = p25, ymax = p75, fill = legend_labels[2])) +
    ggplot2::geom_line(
      ggplot2::aes(y = p50, color = legend_labels[3])) +
    ggplot2::geom_line(
      ggplot2::aes(y = 0)) +
    ggplot2::scale_x_continuous(expand = c(0,0)) +
    ggplot2::scale_y_continuous(labels = scales::comma) +
    ggplot2::scale_fill_manual(values = c(color_25_75,  color_5_95)) +
    ggplot2::scale_color_manual(values = color_median) +
    ggplot2::guides(fill = 
                      ggplot2::guide_legend(reverse=T, order = 1)) +
    ggplot2::labs(x= x_axis_name, y= y_axis_name, fill = legend_name, color = "") +
    ggplot2::facet_wrap(~ factor(decision_option, levels = cashflow_var_name, labels = facet_labels)) +
    ggplot2::theme_bw(base_size = base_size) +
    ggplot2::theme(legend.margin = ggplot2::margin(-0.75, 0, 0, 0, unit = "cm"), 
          strip.background = ggplot2::element_blank(),
          ...)
  
  }