R/scoringInput.R

In lajh87/tessa: Tender Evaluation Strategy Scenario Analysis

scoringInputUI <- function(id, width = NULL) {
  ns <- NS(id)
  box(
    width = width,
    title = "Scoring Rules",
    status = "primary",
    uiOutput(ns("scoring_ui"))
  )
}

scoringInput <- function(input, output, session) {

  ns <- session$ns
  scoring <- reactiveValues(
    input = list(
      selected = "4-Point",
      tiebreak = "Lowest Cost"
    )
  )

  output$scoring_ui <- renderUI({
    fluidRow(
      column(
        width = 5,
        rHandsontableOutput(ns("table"))
      ),
      column(
        width = 7,
        radioButtons(
          inputId = ns("scale"),
          label = "Scale Type",
          choices = c("4-Point", "5-Point"),
          selected = scoring$input$scale,
          inline = TRUE
        ),
        radioButtons(
          inputId = ns("tiebreak"),
          label = "Tiebreak",
          choices = c("Lowest Cost", "Highest Technical"),
          selected = scoring$input$tiebreak,
          inline = TRUE
        )
      )
    )
  })

  four_point <- data.frame(
    Confidence = c("Very High", "High", "Low", "Very Low"),
    Score = as.double(c(10, 7, 3, 0)),
    stringsAsFactors = F
  )

  five_point <- data.frame(
    Confidence = c("Very High", "High", "Medium", "Low", "Very Low"),
    Score = as.double(c(4, 3, 2, 1, 0)),
    stringsAsFactors = F
  )

  selectData <- function(scale, four_point, five_point) {
    if (scale == "4-Point") return(four_point) else return(five_point)
  }

  observeEvent(input$scale, {
    scoring$data <- selectData(input$scale, four_point, five_point)
  })

  output$table <- renderRHandsontable({
    rhandsontable(
      scoring$data,
      rowHeaders = FALSE,
      height = 145
    ) %>%
      hot_col("Confidence", readOnly = TRUE)
  })

  observe({
    if(is.null(input$table))
      return(NULL)
    scoring$data <- hot_to_r(input$table)
  })

  observe({
    scoring$output$tiebreak <- input$tiebreak
    scoring$output$scale <- input$scale
  })

  return(scoring)
}