如何使用 Shiny 和 Leaflet 将 hideGroup 制作成 showGroup

Question

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

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

我如何从隐藏组开始，通过地图层控件打开它们来显示它们，然后在没有组的情况下向 addCircles 半径发送一个新值，然后请切换回隐藏组默认值？

我是否通过隔离解决问题，我还没有通过这种方式取得任何成功？或者我应该采用 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

我刚刚找到了我从Using UI to turn on data and leaflet display on and off 改编的解决方案。我会发布以防其他人发现使用。我从 addLayersControl 中删除了图层选项，并提供了与 checkboxinputs 相同的功能，它通过 observe/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)