在 shiny 应用程序中使用 selectInput 调整功能

Question

The code below generates an output table according to the weights selected by numericInput . This is working fine. The method involved for calculation is the WSM (weighted sum model). For this method it is necessary to choose the weights, which is already being done correctly in the app below, and also if a certain criterion is to maximize or minimize. However, that last question is not being done automatically in code. Notice that it is like this:

scaled <- df1 |>
      mutate(Coverage = min(Coverage) / Coverage, #minimize
             
             Production = Production / max(Production)) #maximize

That is, I manually selected that Coverage is minimize and Production is maximize, but for example it could be the other way around. That's why I created two selectInputs , where the person chooses whether he wants to maximize or minimize a certain criterion. Now how can tweak this in the shiny code so that it stays automatically?

library(shiny)
library(DT)
library(dplyr)
library(shinyjs)
library(MCDM)

df1 <- structure(list(n = c(2, 3, 4, 5, 6, 7, 8, 9, 10, 11), 
                      Coverage = c(0.0363201192049018, 0.0315198954715543,
                                   0.112661460735583, 0.112661460735583, 0.112661460735583, 0.0813721071219816,
                                   0.0862146652218061, 0.0697995564757394, 0.0599194966471805,
                                   0.0507632014547115), 
                      Production =
                        c(1635156.04305, 474707.64025, 170773.40775, 64708.312, 64708.312, 64708.312,
                          949.72635, 949.72635, 949.72635, 949.72635)),
                 class = "data.frame", row.names = c(NA,-10L))

ui <- fluidPage(
  useShinyjs(),
  
  column(4,
         wellPanel(
           numericInput("weight1",label = h4("Weight 1"), min = 0, max = 1, value = NA, step = 0.1),
           selectInput("maxmin1", label = h5("Maximize or Minimize?"),choices = list("Maximize " = 1, "Minimize" = 2), selected = ""),
         
           disabled(numericInput("weight2",label = h4("Weight 2"), min = 0,max = 1,value = NA,step = 0.1)),
           selectInput("maxmin2", label = h5("Maximize or Minimize?"),choices = list("Maximize " = 1, "Minimize" = 2), selected = ""),
           
           helpText("The sum of weights should be equal to 1")
         )),
  hr(),
  column(8,
         tabsetPanel(tabPanel("Method1", DTOutput('table1'))),
         tabsetPanel(tabPanel("Method2", DTOutput('table2')))))

server <- function(input, output, session) {
  
  scaled <- reactive({
    
    weights <- c(req(input$weight1), req(input$weight2))
    
    scaled <- df1 |>
      mutate(Coverage = min(Coverage) / Coverage, #minimize
             
             Production = Production / max(Production)) #maximize
    
    scaled <- scaled |>
      rowwise() |>
      mutate(`Performance Score` = weighted.mean(c(Coverage, Production), w = weights))
    
    scaled$Rank <- (nrow(scaled) + 1) - rank(scaled$`Performance Score`)
    
    scaled
    
    
  })
  

  observeEvent(input$weight1, {
    freezeReactiveValue(input, "weight2")
    updateNumericInput(session, 'weight2', value = 1 - input$weight1)
  })
  
  output$table1 <- renderDT({
    req(scaled())
    datatable(scaled(), options = list( columnDefs = list(list(
          className = 'dt-center', targets = "_all")),paging = TRUE,searching = FALSE,
        pageLength =  10, dom = 'tip',scrollX = TRUE),rownames = FALSE)
  })

}

shinyApp(ui = ui, server = server)

Answer 1

I think you can make the following small change in the server function

    methods <- list("1" = max, "2" = min)
    funcs = c(methods[[req(input$maxmin1)]], methods[[req(input$maxmin2)]])
  
    scaled <- df1 |>
      mutate(Coverage = funcs[[1]](Coverage) / Coverage,
             Production = Production / funcs[[2]](Production))

Notice that I simply create a named list methods that has two elements, the first being the max function and the second being the min function. I have named this list as you have named the choices in the input$maxmin1 and input$maxmin2 objects. Then I create a vector funcs which simply selects the appropriate matching function from the list. In the next lines, I use funcs[[1]] as the function to apply to Coverage and funcs[[2]] as the function to apply to Production