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

Display two visualizations that are based on two different dataframes in modularized shiny app

在下面的模块化闪亮应用程序中,我想创建一张已创建的地图和地图下方的一个绘图。虽然这 2 个可视化基于 2 个不同的数据帧,但我不知道如何显示它们。

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)
  1. 你有 plotlyOutput(ns("plot")) 在不同于 server 的模块中 output$plot<-renderPlotly({ (后者在 plotServer 而 ui 输出在 mapUI).我决定为 plotServer 创建新的 ui,但您也可以尝试将元素从 plotServer 移动到 mapServer
  2. 如您所说,问题出在 returning 多个元素上。但不仅仅是两个数据框,还有一些输入。要 return 个以上的元素,你需要创建列表,这样说: return(list(element1 = _object_to_return1, element2 = _object_to_return2)).
  3. 我在上面说“return 一些输入”,那是因为这里:fig%>% layout(title = paste("Count of",input$sci ,"through the years") 你正在使用输入,但是来自不同模块的输入。如您所知,您无法直接访问来自不同模块的对象,inputs 也是如此。这意味着您还需要 return input,但是 input 需要包装到 reactive() 函数中。在你的例子中,当模块有两个 returns 函数时,它应该是一个并且看起来像这样: return(list(react = react, counted = counted, sci = reactive(input$sci))) .
  4. 现在,因为你有 returned 列表,你需要像访问列表中的普通元素一样访问此列表中的元素,所以当你将参数传递给函数时,它不会 react和以前一样,但是 city_input$react。您还需要向服务器函数添加参数 - 不仅仅是 city,还有 counted 数据帧和 input.
  5. 的参数
  6. 以防对您来说不是很明显 - 访​​问来自其他模块的输入(在作为参数传递后)您可以将其作为普通函数访问,因此在下面您可以看到我使用 sci() 代替共 input$sci

完整代码如下:

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)

上面我改的没有描述的是从这里:

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

我已经删除了 data.frame() 功能。你不需要这个,即使没有这个功能也是data.frame

我也把mode = 'lines'改成了mode = 'markers+lines',因为我看plot里没有数据。但后来我意识到这是因为每只动物在 data.frame 中只有一年(而且 lines 如果情节上只有一个点,你就看不到线)。我了解到您只发布了一部分数据。那当然可以了。