0

我有一个复杂的闪亮应用程序，允许用户从多个主面板中进行选择——其中一个是传单地图。该应用程序还具有一个持久的侧边栏，在所有主面板中都是一致的。此侧边栏允许用户选择在所有应用程序面板中使用的数据。

即使用户不在地图选项卡上，我遇到的问题也与更新地图有关。我看到了这篇文章并尝试了它的解决方案，但是当我翻回地图选项卡时，它会导致地图完全变灰。我怀疑这可能与使用闪亮的模块有关。

这是一个更简单的表示：

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

#--- Data ---#

destination_info <- tribble(
    ~name, ~lng, ~lat,
    "Chicago", -87.62, 41.88,
    "Montreal", -73.51, 45.63 
)

markers <- data.frame(name = rep(c("Chicago", "Montreal"), each = 10),
                      lng = c(rnorm(10, -87.62, 1), rnorm(10, -73.51, 1)),
                      lat = c(rnorm(10, 41.88, 1), rnorm(10, 45.63, 1)))

#--- Modules ---#
# Map Module
mod_map_panel_ui <- function(id) {
    ns <- NS(id)
    
    tagList(
        leafletOutput(ns("map"))
    )
}

mod_map_panel_server <- function(id, r, panel_trigger) {
    moduleServer(
        id,
        function(input, output, session) {
            output$map <- renderLeaflet({
                lng <- r$destination_info$lng
                lat <- r$destination_info$lat
                
                leaflet() %>%
                    addTiles() %>%
                    setView(lng = lng, lat = lat, zoom = 9)
            })
            outputOptions(output, "map", suspendWhenHidden = FALSE)
            
            observeEvent(list(r$markers, panel_trigger), {
                leafletProxy("map") %>%
                    leaflet::clearMarkers() %>%
                    addCircles(lng = ~lng, lat = ~lat, data = r$markers)
            })
        }
    )
}

# Analysis Module
mod_analysis_panel_ui <- function(id) {
    ns <- NS(id)
    
    tagList(
        # empty
    )
}

mod_analysis_panel_server <- function(id) {
    moduleServer(
        id,
        function(input, output, session) {
            # empty
        }
    )
}

#--- Main UI and Server ---#

ui <- tagList(

    sidebarLayout(
        sidebarPanel = sidebarPanel(
            width = 3,
            
            selectInput(
                "dest_select",
                label = "Choose Destination",
                choices = destination_info$name,
                selected = "Chicago"
            )
        ),
        
        mainPanel = mainPanel(
            width = 9,
            
            navbarPage(
                title = "Shiny App",
                id = "main_panel_nav",
                
                tabPanel(
                    title = "Map",
                    mod_map_panel_ui("map_panel")
                ),
                
                tabPanel(
                    title = "Analysis",
                    mod_analysis_panel_ui("analysis_panel")
                )
            )
        )
    )
)

server <- function(input, output) {
    
    # I use this b/c I have multiple attributes I want to pass through the modules
    r <- reactiveValues()

    observe({
        r$destination_info <- destination_info %>%
            filter(name == input$dest_select)
        
        r$markers <- markers %>%
            filter(name == input$dest_select)
    })
    
    mod_map_panel_server("map_panel", r = r, panel_trigger = input$main_panel_nav)
    mod_analysis_panel_server("analysis_panel")
}

shinyApp(ui = ui, server = server)

要重现错误，请单击分析选项卡并更改输入中的目标。然后返回地图选项卡。传单输出应为灰色。

4

0 回答 0