如何使用另一个模块的反应式数据帧更新闪亮模块

该模块的目标是创建一个根据数据选择器模块的输出而变化的反应性条形图。不幸的是，条形图没有更新。它停留在选定的第一个变量上。

我尝试创建观察者函数来更新条形图，但无济于事。我还尝试将选择器服务器模块嵌套在 barplot 模块中，但出现错误：警告：UseMethod 中的错误：没有适用于“mutate”的方法应用于类“c('reactiveExpr', 'reactive'”的对象， '功能'）”

我只需要某种方法来告诉 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)
      
    })
  })
}

EDIT : 数据选择器模块

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)

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

这是一个 MWE 来说明这个概念，通过mtcars或者选择模块和显示模块之间的随机值的数据帧。

关键点是选择模块返回reactive [data]，不是反应性的价值 [data()] 到主服务器功能，然后reactive，不是反应性的价值作为参数传递给绘图模块。

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)