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

时间:2019-06-27 10:06:48

标签: r shiny leaflet

我有两个带有两个letletletproxy的传单输出,每个渲染在一个tabsetpanel内的两个不同的tabpanel上。问题在于,当我选择第二个面板时,第二个letletletproxy无法渲染,我需要先选择一个输入。 我的目标是在选择第二个选项卡而不首先选择输入时呈现第二个传单代理。

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

第83行中的

是此解决方案:render leaflet markers across tabs on shiny startup

第84行中的

是以下解决方案: https://github.com/rstudio/leaflet/issues/590

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

因此,当ShinyApp启动时,我只想渲染第二个选项卡的leafletproxy。我该怎么办?

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)

2 个答案:

答案 0 :(得分:1)

我设法通过在我的反应数据和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)

答案 1 :(得分:0)

不是最优雅的,但是我添加了这个:

  # 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的初始事件,然后在使用once = TRUE对选项卡2进行下一次更改后杀死了这个watchEvent。请参见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)