两个选项卡中的传单输出：LeafletProxy() 最初不在第二个选项卡中呈现

Question

我有两个带有两个leafletproxy 的传单输出，每个都在tabsetpanel 内的两个不同的tabpanel 上呈现。问题是当我选择第二个面板时第二个传单代理没有呈现，我需要先选择一个输入。 我的目标是在我选择第二个选项卡而不先选择输入时呈现第二个传单代理。

我在互联网上找到了一些解决方案，但这些不适合我：

第 83 行是这个解决方案：render leaflet markers across tabs on shiny startup

在第 84 行是这个解决方案： https://github.com/rstudio/leaflet/issues/590

这些解决方案的问题在于，当您来回访问第二个面板时，传单代理会重新加载（请参阅控制台）。当你有少量数据时这不是问题，但那不是我的情况......

所以我只想在 shinyApp 启动时渲染第二个选项卡的传单代理一次。我该怎么做？

library(shiny)
library(leaflet)
library(RColorBrewer)


ui <- fluidPage(

  tags$style(HTML("
                  #map1 {
                  position: absolute;
                  }
                  #map2 {
                  position: absolute;
                  }
                  ")),

  conditionalPanel(
    condition = "input.tabs=='tabMap1'",
    leafletOutput("map1", width="100%", height = "100%")
    ),

  conditionalPanel(
    condition = "input.tabs=='tabMap2'",
    leafletOutput("map2", width="100%", height = "100%")
  ),

  absolutePanel(
    id = "tabPanel",
    class = "panel panel-default",
    style = "padding : 10px",
    top = "2%", 
    left = "2%",
    right = "78%",
    height= "50%",
    tabsetPanel(id = "tabs", 
      tabPanel("tabMap1",
               selectInput("colors1", "Color Scheme",
                           rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
               )),
      tabPanel("tabMap2",
               selectInput("colors2", "Color Scheme",
                           rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
               )
      )
    )
  )
)

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

  # Leaflet Output Map 1
  output$map1 <- renderLeaflet({
    leaflet(quakes) %>% addTiles() %>%
      fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
  })

  colorpal1 <- reactive({
    colorNumeric(input$colors1, quakes$mag)
  })

  # leaflet Proxy Map 1
  observe({
    pal1 <- colorpal1()
    leafletProxy("map1", data = quakes) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
                 fillColor = ~pal1(mag), fillOpacity = 0.7, popup = ~paste(mag)
      )
  })

  # Leaflet Output Map 2
  output$map2 <- renderLeaflet({
    leaflet(quakes) %>% addTiles() %>%
      fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
  })

  colorpal2 <- reactive({
    colorNumeric(input$colors2, quakes$mag)
  })

  # leaflet Proxy Map 2
  observe({
    # input$tabs
    # req(input$tabs == "tabMap2")
    pal2 <- colorpal2()
    leafletProxy("map2", data = quakes) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
                 fillColor = ~pal2(mag), fillOpacity = 0.7, popup = ~paste(mag)
      )
  })
}

shinyApp(ui, server)

Answer 1

不是最优雅的，但我添加了这个：

  # Added for first rendering
  observeEvent(input$tabs, {
    # input$tabs
    # req(input$tabs == "tabMap2")
    pal2 <- colorpal2()
    leafletProxy("map2", data = quakes) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
                 fillColor = ~pal2(mag), fillOpacity = 0.7, popup = ~paste(mag)
      )
  }, ignoreInit = TRUE, once = TRUE)

基本上，我观察 input$tabs 的事件，使用ignoreInit = TRUE 忽略选项卡 1 的初始事件，然后在下一次更改到选项卡 2 后使用 once = TRUE 终止此 observeEvent。在此处查看注释observeEvent。

完整代码如下：

library(shiny)
library(leaflet)
library(RColorBrewer)


ui <- fluidPage(

  tags$style(HTML("
                  #map1 {
                  position: absolute;
                  }
                  #map2 {
                  position: absolute;
                  }
                  ")),

  conditionalPanel(
    condition = "input.tabs=='tabMap1'",
    leafletOutput("map1", width="100%", height = "100%")
  ),

  conditionalPanel(
    condition = "input.tabs=='tabMap2'",
    leafletOutput("map2", width="100%", height = "100%")
  ),

  absolutePanel(
    id = "tabPanel",
    class = "panel panel-default",
    style = "padding : 10px",
    top = "2%", 
    left = "2%",
    right = "78%",
    height= "50%",
    tabsetPanel(id = "tabs", 
                tabPanel("tabMap1",
                         selectInput("colors1", "Color Scheme",
                                     rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
                         )),
                tabPanel("tabMap2",
                         selectInput("colors2", "Color Scheme",
                                     rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
                         )
                )
    )
  )
)

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

  # Leaflet Output Map 1
  output$map1 <- renderLeaflet({
    leaflet(quakes) %>% addTiles() %>%
      fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
  })

  colorpal1 <- reactive({
    colorNumeric(input$colors1, quakes$mag)
  })

  # leaflet Proxy Map 1
  observe({
    pal1 <- colorpal1()
    leafletProxy("map1", data = quakes) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
                 fillColor = ~pal1(mag), fillOpacity = 0.7, popup = ~paste(mag)
      )
  })

  # Leaflet Output Map 2
  output$map2 <- renderLeaflet({
    leaflet(quakes) %>% addTiles() %>%
      fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
  })

  colorpal2 <- reactive({
    colorNumeric(input$colors2, quakes$mag)
  })

  # leaflet Proxy Map 2
  observe({
    # input$tabs
    # req(input$tabs == "tabMap2")
    pal2 <- colorpal2()
    leafletProxy("map2", data = quakes) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
                 fillColor = ~pal2(mag), fillOpacity = 0.7, popup = ~paste(mag)
      )
  })

  # Added for first rendering
  observeEvent(input$tabs, {
    # input$tabs
    # req(input$tabs == "tabMap2")
    pal2 <- colorpal2()
    leafletProxy("map2", data = quakes) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
                 fillColor = ~pal2(mag), fillOpacity = 0.7, popup = ~paste(mag)
      )
  }, ignoreInit = TRUE, once = TRUE)

}

shinyApp(ui, server)

Answer 2

我设法通过在我的反应数据和 renderLeaflet 内的传单代理的层 (addCircles) 上添加一个 isolate() 来找到解决方案，它是这样的：

library(shiny)
library(leaflet)
library(RColorBrewer)


ui <- fluidPage(

  tags$style(HTML("
                  #map1 {
                  position: absolute;
                  }
                  #map2 {
                  position: absolute;
                  }
                  ")),

  conditionalPanel(
    condition = "input.tabs=='tabMap1'",
    leafletOutput("map1", width="100%", height = "100%")
  ),

  conditionalPanel(
    condition = "input.tabs=='tabMap2'",
    leafletOutput("map2", width="100%", height = "100%")
  ),

  absolutePanel(
    id = "tabPanel",
    class = "panel panel-default",
    style = "padding : 10px",
    top = "2%", 
    left = "2%",
    right = "78%",
    height= "50%",
    tabsetPanel(id = "tabs", 
                tabPanel("tabMap1",
                         selectInput("colors1", "Color Scheme",
                                     rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
                         )),
                tabPanel("tabMap2",
                         selectInput("colors2", "Color Scheme",
                                     rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
                         )
                )
    )
  )
  )

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

  # Leaflet Output Map 1
  output$map1 <- renderLeaflet({
    print("map1")
    leaflet(quakes) %>% addTiles() %>%
      fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
  })

  colorpal1 <- reactive({
    colorNumeric(input$colors1, quakes$mag)
  })

  # leaflet Proxy Map 1
  observe({
    print("map1")
    pal1 <- colorpal1()
    leafletProxy("map1", data = quakes) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
                 fillColor = ~pal1(mag), fillOpacity = 0.7, popup = ~paste(mag)
      )
  })

  # Leaflet Output Map 2
  output$map2 <- renderLeaflet({

    foo <- leaflet(quakes) %>% addTiles() %>%
      fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))

    pal2 <- isolate(colorpal2())
    foo %>% addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
                       fillColor = ~pal2(mag), fillOpacity = 0.7, popup = ~paste(mag))
  })

  colorpal2 <- reactive({
    colorNumeric(input$colors2, quakes$mag)
  })

  # leaflet Proxy Map 2
  observe({
    # input$tabs
    #req(input$tabs == "tabMap2")
    pal2 <- colorpal2()
    leafletProxy("map2", data = quakes) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
                 fillColor = ~pal2(mag), fillOpacity = 0.7, popup = ~paste(mag)
      )
  })
}

shinyApp(ui, server)