R/vfmPlot.R

In lajh87/tessa: Tender Evaluation Strategy Scenario Analysis

#' Function to generate a VfM Plot
#' @param results A reactive data frame generated by xxx
#' @param results A reactive data frame generated by yyy
plotVfm <- function(results, strategy){
  req(results$winning_bid)
  req(results$data$Compliant)
  req(strategy$output$select)

  df <- results$data
  df <- df[!is.na(df$Price),]
  df$alpha <- ifelse(df$Compliant == FALSE, 0.2, 1)
  df[,"winning_bid"] <- FALSE
  df[df$Scenario == results$winning_bid, "winning_bid"] <- TRUE

  maxX <- ceiling((max(df$Price, na.rm = T) * 1.1)/10)*10

  p <- plotly::plot_ly(data = df)

  p <- p %>%
    plotly::add_trace(
      x = ~Price,
      y = ~Technical,
      type = "scatter",
      mode = "markers",
      marker = list(size = 10),
      alpha = ~alpha,
      color= ~Scenario
    )

  p <- p %>%
    plotly::layout(xaxis=list(range=c(0, maxX),
                              title="Price (NPV)",
                              zeroline=F),
                   yaxis=list(range=c(-5,105),
                              title="Technical (%)",
                              zeroline=F)) %>%
    plotly::config(displayModeBar =F)

  p <- p %>%
    plotly::add_trace(data = df[df$winning_bid == T,],
                      x = ~Price, y = ~Technical,
                      mode="markers",
                      type = "scatter",
                      color=~Scenario,
                      marker = list(size=12,line=list(color='black', width=2)),
                      showlegend=F, fill=NA)


  vline <- function(x = 0, color = "red") {
    list(
      type = "line",
      y0 = 0,
      y1 = 1,
      yref = "paper",
      x0 = x,
      x1 = x,
      line = list(color = "grey", width = 1, dash = 'dot')
    )
  }

  hline <- function(y = 0) {
    list(
      type = "line",
      x0 = 0,
      x1 = 1,
      xref = "paper",
      y0 = y,
      y1 = y,
      line = list(color = "grey", width = 1, dash = 'dot')
    )
  }

  if(strategy$output$quality_threshold & strategy$output$budget_constraint){
    p <- p %>% plotly::layout(shapes  = list(vline(strategy$output$budget_val),
                                             hline(strategy$output$quality_val)))
  }

  if(strategy$output$budget_constraint | strategy$output$select == "Best Technically Affordable"){
    p <- p %>% plotly::layout(shapes  = list(vline(strategy$output$budget_val)))
  }

  if(strategy$output$quality_threshold){
    p <- p %>% plotly::layout(shapes  = list(hline(strategy$output$quality_val)))
  }

  if(strategy$output$select == "Monetising Non-Cost Score"){
    req(strategy$output$wtp$gradient)
    req(strategy$output$wtp$cost$min)

    b <- strategy$output$wtp$gradient

    df$xMin <- strategy$output$wtp$cost$min
    df$xMax <- maxX

    df$Intercept <- df$Technical-b*df$Price

    df$yMin <- b*df$xMin+df$Intercept
    df$yMax <- b*df$xMax+df$Intercept

    p <- p %>% add_trace(data = df,
                         x = ~c(xMin, xMax),
                         y = ~c(yMin, yMax),
                         type = "scatter",
                         mode = "lines",
                         color=~rep(Scenario,2),
                         line=list(dash="dot")
    )

  }

  return(p)
}