R/visPanel.R

In lajh87/tessa: Tender Evaluation Strategy Scenario Analysis

visPanelUI <- function(id){
  ns <- NS(id)
  tabBox(
    width = NULL,
    id = ns("tabs"),
    tabPanel(
      title = "VfM Plot",
      plotly::plotlyOutput(ns("plot"))
    ),
    tabPanel(
      title = "Criteria",
      d3tm::ztmOutput(ns("treemap"),height = "379px")
    )
  )
}


visPanel <- function(input,output, session, criteria, results, strategy){
  ns <- session$ns

  panel <- reactiveValues(sensitivity_analysis = FALSE,
                          sensitivity_on = FALSE )

  observe({
    req(strategy$output$select)
    if(strategy$output$select %in% c("NAWeighted Value for Money Index",
                                     "NARelative Assessment (Cost to Quality Score)"))
      panel$sensitivity_analysis = TRUE else panel$sensitivity_analysis = FALSE
  })

  observeEvent(panel$sensitivity_analysis,{
    if(panel$sensitivity_analysis == TRUE & panel$sensitivity_on == FALSE){
      appendTab(
        session = session,
        inputId = "tabs",
        tabPanel(
          title = "Sensitivity Analysis",
          value = "sensitivity_analysis",
          plotly::plotlyOutput(ns("sensitivity_analysis"))
        ))
      panel$sensitivity_on <- TRUE
    } else if (panel$sensitivity_analysis == FALSE & panel$sensitivity_on){
      removeTab(
        inputId = "tabs",
        target = "sensitivity_analysis",
        session = session
      )
      panel$sensitivity_on <- FALSE
    }

  },ignoreInit=TRUE, ignoreNULL = TRUE)


  output$plot <- plotly::renderPlotly({
    plotVfm(results, strategy)
  })


  output$treemap <- criteriaPlot(criteria)




  output$sensitivity_analysis <- plotly::renderPlotly({
    if(strategy$output$select == "Weighted Value for Money Index"){
      wQ <- 1:99

      p <- results$data$Price
      q <- results$data$Technical
      s <- results$data$Scenario

      n <- length(p)

      v <- seq_len(n) %>%
        purrr::map_df(function(i){
          wQ %>%
            purrr::map_df(function(x){
              data.frame(wQ = x, Value = q[i]^(x/(100-x))/p[i], Scenario = s[i],
                         stringsAsFactors = F)
            })
        })

     pts <-  2:length(s) %>% purrr::map_df(function(i){
        x1 <- v %>% dplyr::filter(Scenario == s[1])
        xi <- v %>% dplyr::filter(Scenario == s[i])
        w <- which(abs(x1$Value-xi$Value) == min(abs(x1$Value-xi$Value)))
        data.frame(Scenario = xi$Scenario[w],
                   wQ = xi$wQ[w],
                   Value = xi$Value[w],
                   stringsAsFactors = FALSE)

      })

     yAxisScalar <- (max(pts$Value) - min(pts$Value))*0.25
     xAxisScalar <- (max(pts$wQ) - min(pts$wQ))*0.25

    plotly::plot_ly(v, x = ~wQ, y = ~Value, type = "scatter",
                    color = ~Scenario, mode = "lines") %>%
      plotly::add_trace(data = pts, type = "scatter",
                        x=~wQ, y = ~Value, mode = "markers") %>%
      plotly::config(displayModeBar = FALSE) %>%
      plotly::layout(yaxis = list(
        range = c(min(pts$Value)-yAxisScalar, max(pts$Value) + yAxisScalar)
        )) %>%
      plotly::layout(xaxis = list(
        range = c(min(pts$wQ)-xAxisScalar, max(pts$wQ) + xAxisScalar)
      ))

    } else if(strategy$output$select == "Relative Assessment (Cost to Quality Score)"){
      wQ <- 1:99

      p <- results$data$Price
      q <- results$data$Technical
      s <- results$data$Scenario

      n <- length(p)

      v <- seq_len(n) %>%
        purrr::map_df(function(i){
          wQ %>%
            purrr::map_df(function(x){

              x2 <- x/100
              data.frame(wQ = x, TotalScore = (min(p)/p[i]*(1-x2)*100) + (q[i]*x2),
                          Scenario = s[i],
                         stringsAsFactors = F)
            })
        })

      plotly::plot_ly(v, x = ~wQ, y = ~TotalScore, type = "scatter",
                      color = ~Scenario, mode = "lines") %>%
        plotly::config(displayModeBar = FALSE)

    }
  })

}