在 Shiny 應用程序中創建 numericInput 和 function 之間的連接

Question

下面的代碼生成一個帶有簇的 map。 簇數將取決於我的 function 中的k變量。為了獲得這個k值，我使用Weighted Sum Method (WSM)計算。 請注意，對於此計算，有必要選擇標准的權重，在我的例子中只有兩個。 因此， k可以根據所選的權重而變化。 在我的 function 中，我手動輸入 ( weights <- c(0.5,0.5) )。 但是，我想從我創建的兩個numericInput中放置權重。 那么該怎么做呢？ 另一件事，在這種情況下，map 僅在選擇權重后生成。

這個問題可以幫助： 不在服務器上插入所有代碼的方法

library(shiny)
library(rdist)
library(geosphere)
library(shinythemes)
library(leaflet)
library(shinyjs)

function.cl<-function(df,k){
  
  #database df
  df<-structure(list(Properties = c(1,2,3,4,5,6,7), 
                     Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,-23.4,-23.5), 
                     Longitude = c(-49.6, -49.3, -49.4, -49.8, -49.6,-49.4,-49.2), 
                     Coverage = c (1526, 2350, 3526, 2469, 1285, 2433, 2456),
                     Production = c(526, 350, 526, 469, 285, 433, 456)), class = "data.frame", row.names = c(NA, -7L))
  
  
  #Calculation WSM
  
  weights <- c(0.5,0.5) 
  
  scaled <- df |>
    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`)
  
  k<-subset(scaled, Rank==2)$Properties #number of clusters
  
  
  
  #clusters
  coordinates<-df[c("Latitude","Longitude")]
  d<-as.dist(distm(coordinates[,2:1]))
  fit.average<-hclust(d,method="average") 
  clusters<-cutree(fit.average, k) 
  nclusters<-matrix(table(clusters))  
  df$cluster <- clusters 
  df1<-df[c("Latitude","Longitude")]
  
  
  #Color and Icon for map
  ai_colors <-c("red","gray","blue","orange","green","beige")
  
  clust_colors <- ai_colors[df$cluster]
  icons <- awesomeIcons(
    icon = 'ios-close',
    iconColor = 'black',
    library = 'ion',
    markerColor =  clust_colors)
  
  # Map for all clusters:
  m1<-leaflet(df1) %>% addTiles() %>%
    addMarkers(~Longitude, ~Latitude) %>%
    addAwesomeMarkers(lat=~df$Latitude, lng = ~df$Longitude, icon=icons, label=~as.character(df$cluster)) %>% 
    addLegend( position = "topright", title="Cluster", colors = ai_colors[1:max(df$cluster)],labels = unique(df$cluster))
  
  plot1<-m1
  

  
  
  return(list(
    "Plot1" = plot1
  ))
}

ui <- bootstrapPage(
  useShinyjs(),
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      sidebarLayout(
                        sidebarPanel(
                          
                          numericInput("weight1", label = h4("Weight 1"),
                                       min = 0, max = 1, value = NA, step=0.1),
                          
                          disabled(numericInput("weight2", label = h4("Weight 2"),
                                                min = 0, max = 1, value = NA, step=0.1)),
                          
                          helpText("The sum of weights should be equal to 1")),

                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", (leafletOutput("Leaf1",width = "95%", height = "600")))))
                        
                      ))))

server <- function(input, output, session) {
  
  Modelcl<-reactive({
    function.cl(df,k)
  })
  
  output$Leaf1 <- renderLeaflet({
    
    Modelcl()[[1]]
  })
  
  observeEvent(input$weight1, {
    freezeReactiveValue(input, "weight2")
    updateNumericInput(session, 'weight2', value = 1 - input$weight1)
  })
  
}

shinyApp(ui = ui, server = server)

Answer 1

為什么不將 function 重新設計為：

function.cl<-function(weights){
...
}

在服務器端的反應式調用中，您可以這樣做：

Modelcl<-reactive({
    function.cl(weights=c(input$weight1, input$weight2))
  })