r - 如何使用来自另一个模块的 react 性数据框更新 Shiny 模块

Question

此模块的目标是创建一个根据数据选择器模块的输出而变化的响应式(Reactive)条形图。不幸的是，条形图不会更新。它停留在所选的第一个变量处。

我曾尝试创建观察者函数来更新条形图，但无济于事。我也试过将选择器服务器模块嵌套在 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)
      
    })
  })
}

编辑:数据选择器模块

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

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

这里有一个 MWE 来说明这个概念，它在选择模块和显示模块之间传递 mtcars 或随机值的数据帧。

关键点是选择模块返回reactive [data]，而不是reactive的值 [data() ] 到主服务器函数，反过来， react 性，而不是 react 性的值作为参数传递给绘图模块。

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)