r语言 - 如何使用来自另一个模块的响应数据框架更新闪亮模块

Question

本模块的目标是创建一个响应式条形图，该条形图根据数据选择器模块的输出进行更改。不幸的是，条形图没有更新。它停留在第一个被选中的变量

我试过创建观察者函数来更新条形图，但无济于事。我还尝试在barplot模块内嵌套选择器服务器模块，但我得到错误:警告:UseMethod中的错误:不适用于'mutate'的方法应用于类"c('reactiveExpr'， 'reactive'， 'function')">

我只需要一些方法来告诉barplot模块更新每当它被馈送的数据变化。

Barplot模块:

#UI
barplotUI <- function(id) {
tagList(plotlyOutput(NS(id, "barplot"), height = "300px"))
}
#Server
#' @param data Reactive element from another module: reactive(dplyr::filter(austin_map, var == input$var)) 
barplotServer <- function(id, data) {
moduleServer(id, function(input, output, session) {
#Data Manipulation
bardata <- reactive({
bar <-
data  |>
mutate(
`> 50% People of Color` = if_else(`% people of color` >= 0.5, 1, 0),
`> 50% Low Income` = if_else(`% low-income` >= 0.5, 1, 0)
)

total_av <- mean(bar$value)
poc <- bar |> filter(`> 50% People of Color` == 1)
poc_av <- mean(poc$value)
lowincome <- bar |> filter(`> 50% Low Income` == 1)
lowincome_av <- mean(lowincome$value)
bar_to_plotly <-
data.frame(
y = c(total_av, poc_av, lowincome_av),
x = c("Austin Average",
"> 50% People of Color",
"> 50% Low Income")
)

return(bar_to_plotly)
})

#Plotly Barplot
output$barplot <- renderPlotly({
plot_ly(
x = bardata()$x,
y = bardata()$y,
color = I("#00a65a"),
type = 'bar'

) |>
config(displayModeBar = FALSE)

})
})
}

编辑:数据选择模块

dataInput <- function(id) {
tagList(
pickerInput(
NS(id, "var"),
label = NULL,
width = '100%',
inline = FALSE,
options = list(`actions-box` = TRUE,
size = 10),
choices =list(
"O3",
"Ozone - CAPCOG",
"Percentile for Ozone level in air",
"PM2.5",
"PM2.5 - CAPCOG",
"Percentile for PM2.5 level in air")
)
)
}
dataServer <- function(id) {
moduleServer(id, function(input, output, session) {
austin_map <- readRDS("./data/austin_composite.rds")
austin_map <- as.data.frame(austin_map)
austin_map$value <- as.numeric(austin_map$value)

list(
var = reactive(input$var),
df = reactive(austin_map |> dplyr::filter(var == input$var))
)

})
}

简化应用

library(shiny)
library(tidyverse)
library(plotly)
source("barplot.r")
source("datamod.r")

ui = fluidPage(
fluidRow(
dataInput("data"),
barplotUI("barplot")
)
)
server <- function(input, output, session) {
data <- dataServer("data")
variable <- data$df


barplotServer("barplot", data = variable())

}
shinyApp(ui, server)

Answer 1

正如我在评论中所写的，将响应式数据集作为参数传递给模块服务器与传递任何其他类型的参数没有什么不同。

下面是一个MWE，说明了这个概念，在选择模块和显示模块之间传递mtcars或随机值的数据帧。

关键是选择模块将反应[data]，而不是反应的值[data()]返回给主服务器函数，反过来，反应，而不是反应的值作为参数传递给plot模块。

library(shiny)
library(ggplot2)
# Select module
selectUI <- function(id) {
ns <- NS(id)
selectInput(ns("select"), "Select a dataset", c("mtcars", "random"))
}
selectServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
data <- reactive({
if (input$select == "mtcars") {
mtcars
} else {
tibble(x=runif(10), y=rnorm(10), z=rbinom(n=10, size=20, prob=0.3))
} 
})

return(data)
}
)
}
# Barplot module
barplotUI <- function(id) {
ns <- NS(id)

tagList(
selectInput(ns("variable"), "Select variable:", choices=c()),
plotOutput(ns("plot"))
)
}
barplotServer <- function(id, plotData) {
moduleServer(
id,
function(input, output, session) {
ns <- NS(id)

observeEvent(plotData(), {
updateSelectInput(
session, 
"variable", 
choices=names(plotData()), 
selected=names(plotData()[1])
)
})

output$plot <- renderPlot({
# There's an irritating transient error as the dataset
# changes, but handling it would
# detract from the purpose of this answer
plotData() %>% 
ggplot() + geom_bar(aes_string(x=input$variable))
})
}
)
}
# Main UI
ui <- fluidPage(
selectUI("select"),
barplotUI("plot")
)
# Main server
server <- function(input, output, session) {
selectedData <- selectServer("select")
barplotServer <- barplotServer("plot", plotData=selectedData)
}
# Run the application 
shinyApp(ui = ui, server = server)