单独选项卡中的多个传单地图不会出现在 R Shiny Dashboard 中

Question

我正在尝试在单独的选项卡项中渲染地图。当我单独渲染地图时，它工作得很好。但是，当我希望单独的选项卡项目中的地图每个与侧边栏菜单项关联时，我没有得到任何地图。我尝试使用

leafletProxy

但效果不佳。

这是说明我的案例的代码：

library(tidyverse)
library(shiny)
library(leaflet)
library(shinydashboard)

ui <-  dashboardPage(


dashboardHeader(title = 'Interactive Maps'),
  dashboardSidebar(
    sidebarMenu(
      menuItem("1st Map", tabName = "my_map1"),
      menuItem("2nd Map", tabName = "my_map2")
    )
  ),
dashboardBody(

## Create tabs
tabItems(
  
  # mapping
  tabItem('my_map1',
          fluidPage(
            
            # Application title
            titlePanel("Here is map 1"),
            
            # Top panel with county name
            verticalLayout(
               wellPanel(textOutput("zip")),
              
              # the map itself
              mainPanel(
                leafletOutput("map1", width = 700, height = 700)
              )
            )
          )
  ),
  tabItem("my_map2",
          fluidPage(
            
            # Application title
            titlePanel("Here is map 2"),
            
            # Top panel with county name
            verticalLayout(
              wellPanel(textOutput("zip")),
              
              # the map itself
              mainPanel(
                leafletOutput("map2", width = 700, height = 700)
              )
            )
          )
   ) 
  ) 
 )  
)



server <- function(input, output, session) {
  
  output$map1 <- renderLeaflet(
    leaflet() %>% addCircleMarkers(
    lng = runif(10),
    lat = runif(10),
    layerId = paste0("marker", 1:10)))
  
  observeEvent(input$map1_marker_click, {
    leafletProxy("map1", session) %>%
      removeMarker(input$map1_marker_click$id)
  })
  
  output$map2 <- renderLeaflet(
    leaflet() %>% addCircleMarkers(
    lng = runif(20),
    lat = runif(20),
    layerId = paste0("marker", 1:20)))
  
  observeEvent(input$map2_marker_click, {
    leafletProxy("map2", session) %>%
      removeMarker(input$map2_marker_click$id)
  })
  
  
}

shinyApp(ui, server)

Answer 1

问题是由重复的

wellPanel(textOutput("zip"))

引起的 - 只需将渲染函数的结果分配给两个不同的输出即可避免它：

library(tidyverse)
library(shiny)
library(leaflet)
library(shinydashboard)

ui <-  dashboardPage(
  
  
  dashboardHeader(title = 'Interactive Maps'),
  dashboardSidebar(
    sidebarMenu(
      menuItem("1st Map", tabName = "my_map1"),
      menuItem("2nd Map", tabName = "my_map2")
    )
  ),
  dashboardBody(
    
    ## Create tabs
    tabItems(
      
      # mapping
      tabItem('my_map1',
              fluidPage(
                
                # Application title
                titlePanel("Here is map 1"),
                
                # Top panel with county name
                verticalLayout(
                  # wellPanel(textOutput("zip")), # <- issue
                  wellPanel(textOutput("zip1")),

                  # the map itself
                  mainPanel(
                    leafletOutput("map1", width = 700, height = 700)
                  )
                )
              )
      ),
      tabItem("my_map2",
              fluidPage(
                
                # Application title
                titlePanel("Here is map 2"),
                
                # Top panel with county name
                verticalLayout(
                  # wellPanel(textOutput("zip")), # <- issue
                  wellPanel(textOutput("zip2")),
                  
                  # the map itself
                  mainPanel(
                    leafletOutput("map2", width = 700, height = 700)
                  )
                )
              )
      ) 
    ) 
  )  
)



server <- function(input, output, session) {
  
  output$map1 <- renderLeaflet(
    leaflet() %>% addCircleMarkers(
      lng = runif(10),
      lat = runif(10),
      layerId = paste0("marker", 1:10)))
  
  observeEvent(input$map1_marker_click, {
    leafletProxy("map1", session) %>%
      removeMarker(input$map1_marker_click$id)
  })
  
  output$map2 <- renderLeaflet(
    leaflet() %>% addCircleMarkers(
      lng = runif(20),
      lat = runif(20),
      layerId = paste0("marker", 1:20)))
  
  observeEvent(input$map2_marker_click, {
    leafletProxy("map2", session) %>%
      removeMarker(input$map2_marker_click$id)
  })
  
  output$zip2 <- output$zip1 <- renderText({"Something useful"})
  
}

shinyApp(ui, server)