如何使用Shiny和Leaflet将hideGroup变成showGroup

Question

我有一个相当复杂的 Shiny 应用程序，上面有传单地图和许多其他控件。我在下面制作了一个非常简化的版本。

我已将两个组（addMarker 和 addCircles 组）最初设置为不通过将两个图层放置在 hideGroup 函数中进行绘制。然后，我运行该应用程序并在地图上复选框的 addLayersControl 中手动打开它们。 addCircles 组的半径由 sliderInput 进行反应性控制，但是，这会再次运行 hideGroup 函数，并且不会绘制它们，这是我现在不希望发生的情况。我希望他们继续被策划。

如何从隐藏组开始，通过地图图层控件打开它们来显示它们，然后将新值发送到不带组的 addCircles 半径，然后切换回 hidegroup 默认值？

我是否用隔离来解决这个问题，我还没有取得任何成功？或者我应该采取 if_else 条件方法来调用 showGroup 状态？预先感谢。

library(shiny)
library(tidyverse)
library(leaflet)
library(sf)

ui <- fluidPage(
  column(width = 4,
         sliderInput("slt_kam_reach",
                     "KAM",
                     min = 0,
                     max = 50000,
                     step = 1000,
                     value = 5000
         )
         ),
  column(width = 8,
     leafletOutput("lflt_map")
     )
)

kam_data <- data.frame(
  kam_code = c("abc123", "def456"),
  lng = c(18.5, 18.7),
  lat = c(-33.5, -33.7)
)

kam_data_sf <- st_as_sf(
    kam_data,
    coords = c("lng", "lat"),
    crs = "+proj=longlat +datum=WGS84"
  )

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

  output$lflt_map <- renderLeaflet({

    leaflet() %>% 
      addTiles(group = "OSM") %>% 
      addLayersControl(
        overlayGroups = c("KAM",
                          "KAM_reach"),
        options = layersControlOptions(
          collapsed = F
        )
      ) %>% 
      addMarkers(data = kam_data_sf,
                 group = "KAM") %>% 
      addCircles(data = kam_data_sf,
                 group = "KAM_reach",
                 radius = input$slt_kam_reach
                 ) %>% 
      hideGroup("KAM") %>% 
      hideGroup("KAM_reach")

  })
}
shinyApp(ui, server)

Answer 1

我看到你在我完成我的答案后发布了答案。无论如何，这就是：

library(shiny)
library(tidyverse)
library(leaflet)
library(sf)

ui <- fluidPage(
  column(width = 4,
         sliderInput("slt_kam_reach",
                     "KAM",
                     min = 0,
                     max = 50000,
                     step = 1000,
                     value = 5000
         )
         ),
  column(width = 8,
     leafletOutput("lflt_map")
     )
)

kam_data <- data.frame(
  kam_code = c("abc123", "def456"),
  lng = c(18.5, 18.7),
  lat = c(-33.5, -33.7)
)

kam_data_sf <- st_as_sf(
    kam_data,
    coords = c("lng", "lat"),
    crs = "+proj=longlat +datum=WGS84"
  )

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

  output$lflt_map <- renderLeaflet({

    leaflet() %>% 
      addTiles(group = "OSM") %>% 
      addLayersControl(
        overlayGroups = c("KAM",
                          "KAM_reach"),
        options = layersControlOptions(
          collapsed = F
        )
      ) %>% 
      hideGroup("KAM") %>% 
      hideGroup("KAM_reach") %>% 
      fitBounds(min(kam_data$lng),
                min(kam_data$lat),
                max(kam_data$lng),
                max(kam_data$lat))      

  })

  observeEvent(input$slt_kam_reach, {
      leafletProxy("lflt_map") %>% 
          clearGroup("KAM_reach") %>% 
          addMarkers(data = kam_data_sf,
                 group = "KAM") %>% 
          addCircles(data = kam_data_sf,
                 group = "KAM_reach",
                 radius = input$slt_kam_reach
                 )
  })
}
shinyApp(ui, server)

更新

您也可以使用可能更整洁的观察器：

  observe({
      leafletProxy("lflt_map") %>% 
          clearGroup("KAM_reach") %>% 
          addMarkers(data = kam_data_sf,
                 group = "KAM") %>% 
          addCircles(data = kam_data_sf,
                 group = "KAM_reach",
                 radius = input$slt_kam_reach
                 )
  })

Answer 2

我刚刚找到了我改编自使用UI打开和关闭数据和传单显示的解决方案。万一其他人发现有用，我会发帖。我从 addLayersControl 中删除了图层选项，并提供了与 checkboxinputs 相同的功能，它通过观察/if else 构造控制 hidegroup/showgroup 的状态。

library(shiny)
library(tidyverse)
library(leaflet)
library(sf)


ui <- fluidPage(
  column(width = 4,
         fluidRow(
           sliderInput("slt_kam_reach",
                       "KAM",
                       min = 0,
                       max = 50000,
                       step = 1000,
                       value = 5000
           ),
           fluidRow(
             checkboxInput("chbx_KAM", "chbx_KAM"),
             checkboxInput("chbx_kam_reach", "chbx_kam_reach")
           )
         )
         ),
  column(width = 8,
         leafletOutput("lflt_map")
         )


)

kam_data <- data.frame(
  kam_code = c("abc123", "def456"),
  lng = c(18.5, 18.7),
  lat = c(-33.5, -33.7)
)

kam_data_sf <- st_as_sf(
    kam_data,
    coords = c("lng", "lat"),
    crs = "+proj=longlat +datum=WGS84"
  )

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

  output$lflt_map <- renderLeaflet({

    leaflet() %>% 
      addTiles(group = "OSM") %>% 
      addMarkers(data = kam_data_sf,
                 group = "KAM") %>% 
      addCircles(data = kam_data_sf,
                 group = "KAM_reach",
                 radius = input$slt_kam_reach
                 ) 

  })

  proxy <- leafletProxy("lflt_map")

  observe({
    if (input$chbx_KAM == TRUE) {
      proxy %>% showGroup("KAM")
    } else {
      proxy %>% hideGroup("KAM")
    }
  })

  observe({
    if (input$chbx_kam_reach == TRUE) {
      proxy %>% showGroup("KAM_reach")
    } else {
      proxy %>% hideGroup("KAM_reach")
    }
  })


}
shinyApp(ui, server)