Search code examples
rshinyshinymodules

How to use nested modules with a leaflet map


I am trying to use shiny modules to build an App with a leaflet map. However, when I run the code below the map does not render properly -- it is greyed out.

What I would like to happen is that the user selects the city from the side panel and the relevant section of map is shown (there is an example at the end of the question using standard shiny to illustrate).

I think it may be that the user input is not getting correctly passed between modules but do not know how to fix it. And indeed if I change the relevant bit to hard code the city setView(lng = data[data$pt == "London", "lng"], lat = data[data$pt == "London", "lat"], zoom = 9) then the map renders.

Any hints on how to do this with modules please? This is my non-working attempt using modules:

# Some data
data <- data.frame(pt = c("London", "Manchester"), lat=c(51.5, 53.48), lng=c(0.126, -2.24))
  
# Define the side panel UI and server      
sideUI <- function(id) {
                        ns <- NS(id)
                        selectInput(ns("city"), "", choices=data$pt, selected = "London")
                       }

# In this case this server not needed but using uiOuput/renderUI in real case
# sideServer <- function(id) { moduleServer(id,function(input, output, session) { })}
         
# Define the UI and server functions for the map
mapUI <- function(id) {
                    ns <- NS(id)
                    leafletOutput(ns("map"))
                    }    
    
mapServer <- function(id) {
                            moduleServer(
                                id,
                                function(input, output, session) {
                                    output$map <- renderLeaflet({
                                                leaflet() %>%
                                                    addTiles() %>%
                                                    setView(lng = data[data$pt == input$city, "lng"], 
                                                            lat = data[data$pt == input$city, "lat"], 
                                                            zoom = 9) 
                                                    })
                                    })
                                }
    
# Build ui & server and then run
ui <- dashboardPage(
              dashboardHeader(),
              dashboardSidebar(sideUI("side")),
              dashboardBody(mapUI("mapUK"))
          ) 
server <- function(input, output, session) { mapServer("mapUK") }
shinyApp(ui, server)

This is a working example using standard shiny functions which shows what I am trying to do

library(shiny)
library(shinydashboard)
library(leaflet)
ui <- dashboardPage(
              dashboardHeader(),
              dashboardSidebar(selectInput("city", "", choices=data$pt, selected = "London")),
              dashboardBody(leafletOutput("map"))) 
    
server <- function(input, output, session) { 
                output$map <- renderLeaflet({
                                            leaflet() %>%
                                                addTiles() %>%
                                                setView(lng = data[data$pt == input$city, "lng"],
                                                        lat = data[data$pt == input$city, "lat"], 
                                                        zoom = 9) 
                                                })
                                    }
shinyApp(ui, server)

Solution

  • To pass inputs from one module to another, one must return them from the source and use them in the target as an argument.

    
    library(shiny)
    library(shinydashboard)
    library(leaflet)
    
    # Some data
    data <- data.frame(pt = c("London", "Manchester"), lat=c(51.5, 53.48), lng=c(0.126, -2.24))
    
    # Define the side panel UI and server
    sideUI <- function(id) {
      ns <- NS(id)
      selectInput(ns("city"), "", choices=data$pt, selected = "London")
    }
    
    sideServer <- function(id) {
      moduleServer(
        id,
        function(input, output, session) {
    
          # define a reactive and return it
          city_r <- reactiveVal()
          observeEvent(input$city, {
            city_r(input$city)
          })
    
          return(city_r)
        })
    }
    # In this case this server not needed but using uiOuput/renderUI in real case
    # sideServer <- function(id) { moduleServer(id,function(input, output, session) { })}
    
    # Define the UI and server functions for the map
    mapUI <- function(id) {
      ns <- NS(id)
      leafletOutput(ns("map"))
    }
    
    mapServer <- function(id, city) {
      moduleServer(
        id,
        function(input, output, session) {
          output$map <- renderLeaflet({
            leaflet() %>%
              addTiles() %>%
              setView(lng = data[data$pt == city(), "lng"],
                      lat = data[data$pt == city(), "lat"],
                      zoom = 9)
          })
        })
    }
    
    # Build ui & server and then run
    ui <- dashboardPage(
      dashboardHeader(),
      dashboardSidebar(sideUI("side")),
      dashboardBody(mapUI("mapUK"))
    )
    server <- function(input, output, session) {
    
      # use the reactive in another module
      city_input <- sideServer("side")
      mapServer("mapUK", city_input)
    
      }
    shinyApp(ui, server)