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

Question

下面的代码根据 numericInput 选择的权重生成一个numericInput表。 这工作正常。 涉及计算的方法是WSM（加权和模型）。 对于此方法，有必要选择权重，这已经在下面的应用程序中正确完成，并且如果某个标准是最大化或最小化。 但是，最后一个问题不会在代码中自动完成。 注意它是这样的：

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

也就是说，我手动选择Coverage是最小化的， Production是最大化的，但是例如它可能是相反的。 这就是我创建两个selectInputs的原因，人们可以在其中选择他是想最大化还是最小化某个标准。 现在如何在 shiny 代码中调整它以使其自动保留？

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

我认为您可以在服务器 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))

请注意，我只是创建了一个包含两个元素的命名列表methods ，第一个是max function，第二个是min function。我已命名此列表，就像您在input$maxmin1和input$maxmin2对象中命名choices一样。 然后我创建一个向量函数，它只是从列表中选择适当的匹配funcs 。 在接下来的几行中，我使用funcs[[1]]作为 function 应用于Coverage ，使用 funcs funcs[[2]]作为 function 应用于Production