如何使用来自另一个模块的反应性数据框更新闪亮模块

Question

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

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

我只需要一些方法来告诉 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 或随机值的数据帧。

关键点是选择模块returnsreactive[data]，而不是reactive的值 [data()] 到主服务器功能，然后 反应式 ，而不是 反应式的值 作为绘图模块的参数。

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)

如何使用来自另一个模块的反应性数据框更新闪亮模块

How to update shiny module with reactive dataframe from another module

r

shiny

shinymodules