在闪亮的应用程序中使用 selectInput 调整功能

Question

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

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

也就是我手动选择了Coverage是最小化，Production是最大化，但是比如也可以反过来。这就是为什么我创建了两个 selectInputs，人们可以在其中选择他想要最大化还是最小化某个标准。现在如何在闪亮的代码中调整它以使其自动保持？

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

我想你可以在服务器功能上做以下小改动

    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 函数，第二个是 min 函数。我命名此列表的方式与您在 input$maxmin1 和 input$maxmin2 对象中命名 choices 的方式相同。然后我创建一个向量 funcs，它只是从列表中选择适当的匹配函数。在接下来的几行中，我使用 funcs[[1]] 作为应用于 Coverage 的函数，使用 funcs[[2]] 作为应用于 Production

的函数

在闪亮的应用程序中使用 selectInput 调整功能

Adjust features with selectInput in shiny app

r

shiny