依赖于其他闪亮小部件的闪亮小部件在闪亮的模块化应用程序中不起作用

Question

在下面的 shiny 应用程序中，我使用 shiny 模块创建传单地图。问题是与地图交互的 2 个小部件之一依赖于另一个，所以我需要为它们使用 uiOutput() 但我认为它们不能很好地通信，因为它们应该创建的数据集没有创建.

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)

Answer 1

这是改进版：

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)

我改变了什么：

ui 和模块中的服务器应该连接 - 我的意思是，你应该在模块中使用 renderUI 内部服务器（如果 uiOutput 在模块中的 ui 中），不在 app.R 的 server 中。我搬走了。
你在 uiOutput 秒后忘记了 ns()。
最后一件事是 session$ns() 的用法。老实说，我不能说，为什么有必要（我觉得只将 inputId 用作字符串不应该那么容易），但是我今天在某个地方看到了 SO similar problem and解决方案是使用 session$ns() 所以我在这里尝试了这个。如果我猜的话，那是因为 (1) 在服务器部分你需要 session$ns() 如果你想使用 ns()，即你不能只使用 ns()（很难说，为什么); (2) 你需要 ns() 因为你正在使用模块 - 想一想在模块中每当你创建 ui 你需要使用 ns()，所以你也应该使用 ns() 如果您在 server 函数中创建 ui。 也许其他人会过来解释得更好。

依赖于其他闪亮小部件的闪亮小部件在闪亮的模块化应用程序中不起作用

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

module

r

shiny