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

Question

下面的代码根据numericInput选择的权重生成输出表。这很好用。所涉及的计算方法是加权和模型。对于这种方法，有必要选择权重，这已经在下面的应用程序中正确地完成了，如果某个标准是最大化或最小化的话。但是，最后一个问题不是在代码中自动完成的。请注意，它是这样的：

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对象中命名的input$maxmin1和input$maxmin2。然后，我创建一个向量funcs，它简单地从列表中选择合适的匹配函数。在接下来的行中，我使用funcs[[1]]作为应用于Coverage的函数，使用funcs[[2]]作为应用于Production的函数。