在模块化 shiny 应用程序中显示基于两个不同数据帧的两个可视化

Question

In the modularized shiny app below I want to create one map which is created and one plot below the map. The 2 visualizations are based on 2 different dataframes though and I do not know exactly how display them both.

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(leaflet)
library(dplyr)
library(plotly)
# 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)
      counted<-reactive({data.frame(react() %>% 
                                      group_by(year) %>% 
                                      summarise(count=n()
                                      ))
      })
      return(counted)
    })
}
# 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")),
    plotlyOutput(ns("plot"))
  )
}

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))
      })
    })
}
plotServer <- function(id, city) {
  moduleServer(
    id,
    function(input, output, session) {
      output$plot<-renderPlotly({
        
        fig <- plot_ly(data=city(), x = ~as.factor(year), y = ~count, type = 'scatter', mode = 'lines')
        
        fig%>% layout(title = paste("Count of",input$sci ,"through the years"),
                      xaxis = list(title = "Years",tickangle=45),
                      yaxis = list (title = "Count"))
      })
    })
}
# 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)
  plotServer("plotPl",city_input)
  
}
shinyApp(ui, server)

Answer 1

1. You have plotlyOutput(ns("plot")) in different module than server where is output$plot<-renderPlotly({ (the latter is in plotServer while ui output is in mapUI ). I decided to make new ui for plotServer , but you can also try to move elements from plotServer into mapServer .
2. As you said, the problem is with returning multiple elements. But not just two dataframes, also some input. To return more than one element, you need to create list, say like this: return(list(element1 = _object_to_return1, element2 = _object_to_return2)) .
3. I said above "return some input", that's because here: fig%>% layout(title = paste("Count of",input$sci,"through the years") you are using input, but input from different module. As you already know, you do not have direct access to objects from different modules and the same is with input s. That means you need to return input as well, but input needs to be wrapped into reactive() function. In your case, when there is module with two return s function, it should be one and look like this: return(list(react = react, counted = counted, sci = reactive(input$sci))) .
4. Now, because you have returned list, you need to access elements inside this list as normal elements from list, so when you pass arguments to function, it won't be react as previously, but city_input$react . You also need to add parameters to the server function - not just city , but also parameter for counted dataframe and input .
5. In case it won't be obvious for you - to access input from other module (after passing as argument) you access it as a normal function, so below you can see that I use sci() instead of input$sci

Here is full code:

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(leaflet)
library(dplyr)
library(plotly)
# 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], 
          
        )
      })
      
      counted<-reactive({react() %>% 
                                      group_by(year) %>% 
                                      summarise(count=n()
                                      )
        
      })
      return(list(react = react, counted = counted, sci = reactive(input$sci)))
    })
}
# 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))
      })
    })
}

plotUI <- function(id) {
  ns <- NS(id)
  
  tagList(
    plotlyOutput(ns("plot"))
  )
}

plotServer <- function(id, city, sci) {
  moduleServer(
    id,
    function(input, output, session) {
      output$plot<-renderPlotly({
        
        fig <- plot_ly(data=city(), x = ~as.factor(year), y = ~count, type = 'scatter', mode = 'markers+lines')
        
        fig%>% layout(title = paste("Count of", sci(),"through the years"),
                      xaxis = list(title = "Years",tickangle=45),
                      yaxis = list (title = "Count"))
      })
    })
}
# Build ui & server and then run
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(sideUI("side")),
  dashboardBody(mapUI("mapUK"), plotUI("plotPl"))
)
server <- function(input, output, session) {
  
  # use the reactive in another module
  city_input <- sideServer("side")
  mapServer("mapUK", city_input$react)
  plotServer("plotPl", city_input$counted, sci = city_input$sci)
  
}
shinyApp(ui, server)

What I have changed and didn't describe above is that from this:

counted<-reactive({data.frame(react() %>% 
                                      group_by(year) %>% 
                                      summarise(count=n()
                                      ))
      })

I have removed data.frame() function. You don't need this, it will be data.frame even without this function.

I have also changed mode = 'lines' into mode = 'markers+lines' , because I saw no data in plot. But then I realized it's because for each animal is only one year in data.frame (and just with lines you can't see line if there is only one point on plot). I understand that you posted just a part of data. That's of course fine.