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

问题描述 投票：0回答：2

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

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

第 83 行是这个解决方案：在闪亮的启动时跨选项卡渲染传单标记

第 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)
r shiny r-leaflet
2个回答
2
投票

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

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
投票

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

  # 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)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.