Вывод листовок на двух вкладках: LeafletProxy () изначально не отображается на второй вкладке - PullRequest
Новая
       23

Вывод листовок на двух вкладках: LeafletProxy () изначально не отображается на второй вкладке

0 голосов
/ 27 июня 2019

У меня есть два выходных листка с двумя листовыми прокси, каждый из которых рендерится на две разные панели вкладок внутри панели вкладок. проблема в том, что второй листпрокси не отображается при выборе второй панели, мне нужно сначала выбрать вход. Моя цель состоит в том, чтобы сделать второй прокси листовки, когда я выбираю вторую вкладку, не выбирая ввод первым.

Я нашел какое-то решение в интернете, но оно мне не подходит:

в строке 83 - это решение: отображать маркеры листовок на вкладках при блестящем запуске

в строке 84 это решение: https://github.com/rstudio/leaflet/issues/590

проблема с этими решениями заключается в том, что когда вы возвращаетесь назад и вперед ко второй панели, прокси-листовка перезагружается (см. Консоль). Это не проблема, когда у вас есть небольшое количество данных, но это не мой случай ...

Так что я хотел бы отобразить прокси-лист leaflet второй вкладки только один раз, когда запускается приложениеручное. Как я могу это сделать? 

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 ]

1 голос
/ 27 июня 2019

Мне удалось найти решение, добавив isolate () к моим реактивным данным и слою (addCircles) прокси-сервера листовки внутри renderLeaflet, это выглядит так: 

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)
0 голосов
/ 27 июня 2019

Не самый элегантный, но я добавил это: 

  # 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)

По сути, я наблюдаю событие ввода $ tabs, игнорируя исходное для вкладки 1 с ignoreInit = TRUE, а затем убив этот наблюдаемый объект после следующего изменения на вкладке 2 с помощью once = TRUE. См. Примечания здесь наблюдать за событием .

Полный код ниже: 

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)
...