如何使action button EventResponsive（）对多个滑动条进行响应

我试图让shiny在用户单击操作按钮后使用滑动条值进行计算。这些滑动条代表五个维度，用户可以拖动这些维度来设置每个变量的首选权重值。单击“操作”按钮后，应用程序应显示荷兰地图，其中包含基于这些权重值的“得分”最高的城市。目前，我已经运行了以下代码，但是在您单击操作按钮之后，运行速度非常慢，因为当反应滑动条发生变化时，它将自动重新执行。是否有人建议加快我的代码，并使操作按钮eventReactive，以便必须单击它才能让shiny知道如何进行新的计算

因为我想不出一种更简单的方法来共享我的数据（spatialpolygonsdataframe），所以我在主脚本中加入了一个要点链接：

闪亮应用程序的屏幕截图：

应用程序R

library(shiny)
library(leaflet)

ui <- fluidPage(
  titlePanel("Quality-of-life-o-meter of The Netherlands"),

  sidebarLayout(
    sidebarPanel(
      h3("Dimensions"),
      h6("Assign a weight value for every dimension and press the 'find!' button"),
      sliderInput("housingslider", 
                  label = h4("Housing"), 
                  min = 1, 
                  max = 5, 
                  value = 1),
      sliderInput("populationslider", 
                  label = h4("Population"), 
                  min = 1, 
                  max = 5, 
                  value = 1),
      sliderInput("provisionsslider", 
                  label = h4("Provisions"), 
                  min = 1, 
                  max = 5, 
                  value = 1),
      sliderInput("safetyslider", 
                  label = h4("Safety"), 
                  min = 1, 
                  max = 5, 
                  value = 1),
      sliderInput("physicalenvslider", 
                  label = h4("Physical Environment"), 
                  min = 1, 
                  max = 5, 
                  value = 1),
      actionButton("action", label = "Find!")
    ),
    mainPanel(
      leafletOutput("mymap", height = "800")
    )
  )
)

server <- function(input, output, session) {

  output$mymap <-renderLeaflet({
    # Create interactive map of Total Score of Muncipalities in 2016 to display first
    leaflet(data = MunScores2016) %>% addTiles() %>%
      addPolygons(fillColor = ~pal(Total_Score_2016), 
                  fillOpacity = 1, 
                  color = 'white', 
                  weight = 1,
                  popup = popup_dat) %>%
      addLegend("bottomright", # Legend position
                pal=pal, # color palette
                values=~Total_Score_2016, # legend values
                opacity = 0.7,
                title="Percentage difference from national average")
  })  

  observeEvent(input$action,
               output$mymap <-renderLeaflet({
                 Total_Score <- NA
                 Total_Score <- ((input$housingslider * MunScores2016$Housing_Score_2016 +
                                input$populationslider * MunScores2016$Population_Score_2016 +
                                input$provisionsslider * MunScores2016$Provisions_Score_2016 +
                                input$safetyslider * MunScores2016$Safety_Score_2016 +
                                input$physicalenvslider * MunScores2016$PhysicalEnvironment_Score_2016)/
                               (input$housingslider + input$populationslider + input$provisionsslider + input$safetyslider + input$physicalenvslider))
             #Create interactive map
                 leaflet(data = MunScores2016) %>% addTiles() %>%
                   addPolygons(fillColor = ~pal(Total_Score), 
                               fillOpacity = 1, 
                               color = 'white', 
                               weight = 1,
                               popup = paste0("<strong>Municipality:</strong>", 
                                          MunScores2016$Municipality_Name, 
                                          "<br><strong>Quality-of-life-o-meter says: </strong>", 
                                          Total_Score)) %>%
                   addLegend("bottomright", # Legend position
                             pal=pal, # color palette
                             values=~Total_Score_2016, # legend values
                             opacity = 0.7,
                             title="Weighted percentage difference from national average")
               })

  )
}  
shinyApp(ui = ui, server = server)

库（闪亮）
图书馆（单张）
ui%
添加图例（“右下角”），图例位置
pal=pal，#调色板
值=~2016年总得分，#图例值
不透明度=0.7，
title=“与全国平均水平的百分比差异”）
})  
observeEvent（输入$action，
输出$mymap%
添加图例（“右下角”），图例位置
pal=pal，#调色板
值=~2016年总得分，#图例值
不透明度=0.7，
title=“与全国平均水平的加权百分比差异”）
})
)
}  
shinyApp（用户界面=用户界面，服务器=服务器）

您的代码很慢，因为您在不知情的情况下不断地重新创建所有内容

---

刷新 让我首先解决滑块刷新问题：

在

observeEvent

（仅当按下按钮时才会触发）中，可以将反应性环境指定给

输出$mymap

（所有渲染功能都是反应性环境）

在

renderLeaflet

中，您可以命名输入参数，在这种情况下，Shiny将自动跟踪这些输入作为可观察值

因此，只要单击按钮，渲染函数的分配就会发生，但渲染函数本身并不限于此事件，因为反应性环境的寿命比分配调用的寿命更长

有两种方法可以将此逻辑从渲染函数中拉出

1） 在每个输入引用周围使用

隔离
。（即，
隔离（输入$housingslider）
）。这样，您将抑制到输入滑块的反应链接，并且“渲染可观察对象”将不再具有更新触发器，仅在创建时更新一次

output$mymap <-renderLeaflet({
  Total_Score <- NA
  # isolate(expr) prevents observables in expr from being subscribed to.
  Total_Score <- isolate(
    (
      input$housingslider * MunScores2016$Housing_Score_2016
      + input$populationslider * MunScores2016$Population_Score_2016  
      + input$provisionsslider * MunScores2016$Provisions_Score_2016 
      + input$safetyslider * MunScores2016$Safety_Score_2016
      + input$physicalenvslider * PhysicalEnvironment_Score_2016
    ) / (
      input$housingslider
      + input$populationslider
      + input$provisionsslider 
      +  input$safetyslider 
      + input$physicalenvslider
    )
  )

  ...
})


重画
但是现在我们来看看您实际应该如何实现它：使用
proxy

每次调用
renderLeaflet
，都会销毁以前使用过的地图对象，并创建一个全新的地图对象（并再次创建所有分幅，这意味着也会获取这些资源）。只要看到缩放和视图位置每次都被重置，您就会意识到这一点

有一种方法可以重用以前创建的地图

函数
proxy（）
允许您访问使用
output$%addLegend创建的映射(
“右下角”，
pal=pal，
值=~2016年的总得分，
不透明度=0.7，
title=“与全国平均水平的百分比差异”）
})
observeEvent（输入$action{
总分%1分(
fillColor=~pal（总分），
fillOpacity=1，
颜色='白色'，
重量=1，
popup=paste0（“市政：”，
MunScores2016$市政当局名称，
“
生命质量测量仪显示：”，
总分
#如您所见，不需要addLegend，因为图例不会更改。
})
}

使用此选项，上述所有刷新问题将不再发生，因为您不会为映射重新创建反应式环境。不过，我认为第一部分将来可能会有所帮助。
您可能应该只有一个
输出$
调用。此外，如果您将反应性内容放入
output$
调用中，那么只要这些反应性对象发生更改，输出就会发生更改。您需要分离出您的过滤器，以便它们仅在使用
this.filter Hi K.Rohde单击操作按钮时更改。感谢您的广泛回复。这真的让人大开眼界！但是，当我第一次尝试您的代码时，我遇到了一个错误：“derivePolygons中的错误：未找到多边形数据；请为addPolygons提供数据和/或lng/lat参数。”看起来addPolygons（）仍然需要一个数据参数，该参数必须是MunScores2016。它现在运行良好，但仍然非常缓慢。不包括addLegend的一个缺点是，图例不再根据新的多边形数据/颜色进行更新。所以我想我还是必须添加图例。@rython很抱歉，我没有测试它，因为我没有数据可以处理。
observeEvent(input$action, {
  Total_Score <- NA
  # isolate(expr) prevents observables in expr from being subscribed to.
  Total_Score <- (
    input$housingslider * MunScores2016$Housing_Score_2016
    + input$populationslider * MunScores2016$Population_Score_2016  
    + input$provisionsslider * MunScores2016$Provisions_Score_2016 
    + input$safetyslider * MunScores2016$Safety_Score_2016
    + input$physicalenvslider * PhysicalEnvironment_Score_2016
  ) / (
    input$housingslider
    + input$populationslider
    + input$provisionsslider 
    +  input$safetyslider 
    + input$physicalenvslider
  )

  output$mymap <-renderLeaflet({
    # Use Total_Score here and no input$
    ...
  })
})

server <- function(input, output, session) {

  # Create Map once.
  output$mymap <-renderLeaflet({
    leaflet(data = MunScores2016)
      %>% addTiles()
      %>% addPolygons(
        fillColor = ~pal(Total_Score_2016),
        fill2Opacity = 1, 
        color = 'white', 
        weight = 1,
        popup = popup_dat)
      %>% addLegend(
        "bottomright",
        pal=pal,
        values=~Total_Score_2016,
        opacity = 0.7,
        title="Percentage difference from national average")
  })

  observeEvent(input$action, {
    Total_Score <- NA
    Total_Score <- ((input$housingslider * MunScores2016$Housing_Score_2016 +
      input$populationslider * MunScores2016$Population_Score_2016 +
      input$provisionsslider * MunScores2016$Provisions_Score_2016 +
      input$safetyslider * MunScores2016$Safety_Score_2016 +
      input$physicalenvslider * MunScores2016$PhysicalEnvironment_Score_2016)/
      (input$housingslider + input$populationslider + input$provisionsslider + input$safetyslider + input$physicalenvslider))

    # Just update the existing map
    leafletProxy("mymap")
      # This you have to do now: remove the existing polygons, before you paint new ones.
      %>% clearShapes()
      %>% addPolygons(
        fillColor = ~pal(Total_Score), 
        fillOpacity = 1, 
        color = 'white', 
        weight = 1,
        popup = paste0("<strong>Municipality:</strong>", 
          MunScores2016$Municipality_Name, 
          "<br><strong>Quality-of-life-o-meter says: </strong>", 
          Total_Score))
      # As you can see, no addLegend is needed, since the legend does not change. 
  })
}