无需在服务器上插入所有代码的方法

Question

下面的代码使用WSM（加权求和法）方法生成最终排名table。为此，有必要 select 标准权重。正如在代码中一样，我手动选择标准权重 (weights <- c(0.5,0.5) )。从这个意义上讲，我做了两个 numericInput 来选择权重。解决此问题的一种方法是将所有内容放在 server 上的 reactive 中，如此处所回答：

但是，我希望看到不剥离引用 server 上的 WSM 计算的代码的可能性，就像我在 link 的答案中所做的那样。在这种情况下，这部分代码：

weights <- c(0.5,0.5) 

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

scaled <- scaled |>
  rowwise() |>
  mutate(`Performance Score` = weighted.mean(c(Coverage, Production), w = weights))

scaled$Rank <- (nrow(scaled) + 1) - rank(scaled$`Performance Score`)

那么，有没有其他的解决方法呢？

library(shiny)
library(shinythemes)
library(dplyr)

df1<-structure(list(nclusters = c(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 
28, 29, 30, 31, 32, 33, 34, 35), Coverage = c(0.0363201192049018, 
0.0315198954715543, 0.112661460735583, 0.112661460735583, 0.112661460735583, 
0.0813721071219816, 0.0862146652218061, 0.0697995564757394, 0.0599194966471805, 
0.0507632014547115, 0.052076958349629, 0.052076958349629, 0.052076958349629, 
0.052076958349629, 0.052076958349629, 0.052076958349629, 0.0410332568832433, 
0.0389940601722214, 0.0441742111970355, 0.0441742111970355, 0.0441742111970355, 
0.0438099091238968, 0.0409906284310306, 0.0409906284310306, 0.035480410134286, 
0.035480410134286, 0.035480410134286, 0.035480410134286, 0.035480410134286, 
0.035480410134286, 0.035480410134286, 0.0345381204372174, 0.0287729883480053, 
0.0287729883480053), Production = c(1635156.04305, 474707.64025, 
170773.40775, 64708.312, 64708.312, 64708.312, 949.72635, 949.72635, 
949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 
949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 
949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 
949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 
949.72635, 949.72635)), class = "data.frame", row.names = c(NA,-34L))

weights <- c(0.5,0.5) 

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

scaled <- scaled |>
  rowwise() |>
  mutate(`Performance Score` = weighted.mean(c(Coverage, Production), w = weights))

scaled$Rank <- (nrow(scaled) + 1) - rank(scaled$`Performance Score`)

ui <- fluidPage(

    column(4,
         wellPanel(
           
  numericInput("weight1", label = h4("Weight 1"),
               min = 0, max = 1, value = ""),

 selectInput("maxmin1", label = h5("Maximize or Minimize?"),
                       choices = list("","Maximize " = "+", "Minimize" = "-"), selected = NULL),
  
  numericInput("weight2", label = h4("Weight 2"),
               min = 0, max = 1, value = ""),
  
 selectInput("maxmin2", label = h5("Maximize or Minimize?"),
                       choices = list("","Maximize " = "+", "Minimize" = "-"), selected = NULL),
  helpText("The sum of weights should be equal to 1"))),
  
  hr(),
  
  column(8,
         tabsetPanel(
           tabPanel("table", dataTableOutput('table'))))

)

server <- function(input, output,session) {
  
  observeEvent(input$weight1, {
    updateNumericInput(session, 'weight2',
                       value = 1 - input$weight1)
  })

  output$table <- renderDataTable({
  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

您可以创建一个获取权重的函数，然后在 eventReactive() 中调用该函数 [也可以使用其他方法]

library(shiny)
library(shinythemes)
library(dplyr)

df1<-structure(list(nclusters = c(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
                                  12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 
                                  28, 29, 30, 31, 32, 33, 34, 35), Coverage = c(0.0363201192049018, 
                                                                                0.0315198954715543, 0.112661460735583, 0.112661460735583, 0.112661460735583, 
                                                                                0.0813721071219816, 0.0862146652218061, 0.0697995564757394, 0.0599194966471805, 
                                                                                0.0507632014547115, 0.052076958349629, 0.052076958349629, 0.052076958349629, 
                                                                                0.052076958349629, 0.052076958349629, 0.052076958349629, 0.0410332568832433, 
                                                                                0.0389940601722214, 0.0441742111970355, 0.0441742111970355, 0.0441742111970355, 
                                                                                0.0438099091238968, 0.0409906284310306, 0.0409906284310306, 0.035480410134286, 
                                                                                0.035480410134286, 0.035480410134286, 0.035480410134286, 0.035480410134286, 
                                                                                0.035480410134286, 0.035480410134286, 0.0345381204372174, 0.0287729883480053, 
                                                                                0.0287729883480053), Production = c(1635156.04305, 474707.64025, 
                                                                                                                    170773.40775, 64708.312, 64708.312, 64708.312, 949.72635, 949.72635, 
                                                                                                                    949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 
                                                                                                                    949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 
                                                                                                                    949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 
                                                                                                                    949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 949.72635, 
                                                                                                                    949.72635, 949.72635)), class = "data.frame", row.names = c(NA,-34L))
get_scaled <- function(w1,w2,m1,m2) {
  weights = c(w1,w2)
  method = list("-" = min,"+"=max)
  m1 = method[[m1]]
  m2 = method[[m2]]
  scaled <- df1 |>
    mutate(Coverage = m1(Coverage) / Coverage,
           Production = Production / m2(Production))
  
  scaled <- scaled |>
    rowwise() |>
    mutate(`Performance Score` = weighted.mean(c(Coverage, Production), w = weights))
  
  scaled$Rank <- (nrow(scaled) + 1) - rank(scaled$`Performance Score`)
  return(scaled)
}


ui <- fluidPage(
  
  column(4,
         wellPanel(
           
  numericInput("weight1", label = h4("Weight 1"),
               min = 0, max = 1, value = ""),

 selectInput("maxmin1", label = h5("Maximize or Minimize?"),
                       choices = list("","Maximize " = "+", "Minimize" = "-"), selected = NULL),
  
  numericInput("weight2", label = h4("Weight 2"),
               min = 0, max = 1, value = ""),
  
 selectInput("maxmin2", label = h5("Maximize or Minimize?"),
                       choices = list("","Maximize " = "+", "Minimize" = "-"), selected = NULL),
  helpText("The sum of weights should be equal to 1"))),  
  hr(),
  
  column(8,
         tabsetPanel(
           tabPanel("table", dataTableOutput('table'))))
  
)

server <- function(input, output,session) {
  
  observeEvent(input$weight1, {
    updateNumericInput(session, 'weight2',
                       value = 1 - input$weight1)
  })
  
    scaled <- reactive({
    get_scaled(input$weight1, input$weight2, input$maxmin1,input$maxmin2)
  })
  
  output$table <- renderDataTable({
    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)

无需在服务器上插入所有代码的方法

Approach without inserting all the code on the server

r

shiny