0

ユーザーが複数のメインパネルから選択できる複雑な光沢のあるアプリがあります-そのうちの1つはリーフレットマップです。このアプリには、すべてのメイン パネルで一貫した永続的なサイドバーも備わっています。このサイドバーを使用すると、ユーザーはアプリのすべてのパネルで使用されるデータを選択できます。

私が抱えている問題は、ユーザーがマップタブにいないときでもマップを更新することに関係しています。この投稿を見て解決策を試しましたが、マップ タブに戻ると完全に灰色のマップになります。光沢のあるモジュールの使用に関係があるのではないかと思います。

より単純な reprex を次に示します。

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