Shiny widget that is dependent on other shiny widget does not work in shiny modularized app-CodePudding

In the shiny app below I use shiny modules to create a leaflet map. The issue is that the one of the 2 widgets that interact with the map is dependent on the other so I need to use uiOutput() for them but I do not think that they communicate well since the dataset that they should have created is not created.

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(leaflet)
library(dplyr)

# Some data
data<-structure(list(scientificName = c("Turdus merula Linnaeus, 1758", 
                                        "Passer domesticus (Linnaeus, 1758)", "Cantharellus cinereus (Pers.) Fr.", 
                                        "Flammulina fennae Bas", "Mycena crocata (Schrad.) P.Kumm.", 
                                        "Lepista luscina (Fr.) Singer", "Mycena permixta (Britzelm.) Sacc.", 
                                        "Rhodophyllus byssisedus (Pers.) Quel.", "Rhodophyllus porphyrophaeus (Fr.) J.E.Lange", 
                                        "Panaeolus rickenii Hora"), decimalLatitude = c(52.204429, 51.387818, 
                                                                                        52.176667, 50.066111, 49.179167, 49.419444, 52.3, 52.3, 49.419444, 
                                                                                        49.179167), decimalLongitude = c(21.189275, 19.62673, 19.088056, 
                                                                                                                         19.502778, 22.434722, 20.380556, 20.566667, 20.566667, 20.380556, 
                                                                                                                         22.434722)), row.names = c(1L, 2L, 32L, 35L, 37L, 38L, 39L, 40L, 
                                                                                                                                                    41L, 42L), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"
                                                                                                                                                    ))
data$year<-c(1990,1989,2003,1990,1980,1990,1989,2003,1990,1980)
# Define the side panel UI and server
sideUI <- function(id) {
  ns <- NS(id)
  tagList(
    
    uiOutput("ye"),
    uiOutput("scient"),
    actionButton(ns("action"),"Submit")
  )
  
}

sideServer <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      
      # define a reactive and return it
      react<-eventReactive(input$action,{
        
        omited <-subset(data, data$scientificName %in% isolate(input$sci))
      })
      
      return(react)
      
    })
}
# 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)
  tagList(
    leafletOutput(ns("map"))
  )
}

mapServer <- function(id, city) {
  moduleServer(
    id,
    function(input, output, session) {
      output$map<-renderLeaflet({
        
        leaflet(data = city()) %>% addTiles() %>%
          addMarkers(~decimalLatitude, ~decimalLongitude, popup = ~as.character(scientificName), label = ~as.character(scientificName))
      })
    })
}

# Build ui & server and then run
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(sideUI("side")),
  dashboardBody(mapUI("mapUK"))
)
server <- function(input, output, session) {
  output$ye<-renderUI({
    pickerInput(
      inputId = "yea",
      label = "Year", 
      choices = sort(unique(data$year),decreasing=F),
      selected = unique(data$year),
      multiple = T
      
    )
  })
  output$scient<-renderUI({
    data <-subset(data, data$year %in% input$yea)
    
    pickerInput(
      inputId = "sci",
      label = "Scientific name", 
      choices = unique(data$scientificName),
      selected = unique(data$scientificName)[1], 
      
    )
  })
  # use the reactive in another module
  city_input <- sideServer("side")
  mapServer("mapUK", city_input)
  
}
shinyApp(ui, server)

CodePudding user response：

Here is improved version:

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(leaflet)
library(dplyr)

# Some data
data<-structure(list(scientificName = c("Turdus merula Linnaeus, 1758", 
                                        "Passer domesticus (Linnaeus, 1758)", "Cantharellus cinereus (Pers.) Fr.", 
                                        "Flammulina fennae Bas", "Mycena crocata (Schrad.) P.Kumm.", 
                                        "Lepista luscina (Fr.) Singer", "Mycena permixta (Britzelm.) Sacc.", 
                                        "Rhodophyllus byssisedus (Pers.) Quel.", "Rhodophyllus porphyrophaeus (Fr.) J.E.Lange", 
                                        "Panaeolus rickenii Hora"), decimalLatitude = c(52.204429, 51.387818, 
                                                                                        52.176667, 50.066111, 49.179167, 49.419444, 52.3, 52.3, 49.419444, 
                                                                                        49.179167), decimalLongitude = c(21.189275, 19.62673, 19.088056, 
                                                                                                                         19.502778, 22.434722, 20.380556, 20.566667, 20.566667, 20.380556, 
                                                                                                                         22.434722)), row.names = c(1L, 2L, 32L, 35L, 37L, 38L, 39L, 40L, 
                                                                                                                                                    41L, 42L), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"
                                                                                                                                                    ))
data$year<-c(1990,1989,2003,1990,1980,1990,1989,2003,1990,1980)
# Define the side panel UI and server
sideUI <- function(id) {
  ns <- NS(id)
  tagList(
    
    uiOutput(ns("ye")),
    uiOutput(ns("scient")),
    actionButton(ns("action"),"Submit")
  )
  
}

sideServer <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      
      # define a reactive and return it
      react<-eventReactive(input$action,{
        
        omited <-subset(data, data$scientificName %in% isolate(input$sci))
      })
      
      output$ye<-renderUI({
        pickerInput(
          inputId = session$ns("yea"),
          label = "Year", 
          choices = sort(unique(data$year),decreasing=F),
          selected = unique(data$year),
          multiple = T
          
        )
      })
      
      output$scient<-renderUI({
        data <-subset(data, data$year %in% input$yea)
        
        pickerInput(
          inputId = session$ns("sci"),
          label = "Scientific name", 
          choices = unique(data$scientificName),
          selected = unique(data$scientificName)[1], 
          
        )
      })
      
      return(react)
      
    })
}
# 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)
  tagList(
    leafletOutput(ns("map"))
  )
}

mapServer <- function(id, city) {
  moduleServer(
    id,
    function(input, output, session) {
      output$map<-renderLeaflet({
        
        leaflet(data = city()) %>% addTiles() %>%
          addMarkers(~decimalLatitude, ~decimalLongitude, popup = ~as.character(scientificName), label = ~as.character(scientificName))
      })
    })
}

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

What I have changed:

ui and server in module should be connected - I mean, you should use renderUI insider server in module (if uiOutput is in ui in module), not in server from app.R. I moved them.
You forgot about ns() in two uiOutputs.
And the last thing is usage of session$ns(). To be honest, I can't say, why it is necessary (I rather feel that it shouldn't be so easy to just use inputId as a string only), however I saw today somewhere in SO similar problem and there solution was to use session$ns() so I tried this here. If I would guess, it is because (1) in server part you need session$ns() if you want to use ns(), i.e. you can't use just ns() (hard to say, why); (2) you need ns() because you are working with module - think of it that in module whenever you create ui you need to use ns(), so you should also use ns() if you create ui in server function. Maybe someone else come here and explain it better.