如何使用來自另一個模塊的反應數據框更新閃亮的模塊

Question

該模塊的目標是創建一個響應式條形圖，該條形圖根據數據選擇器模塊的輸出而變化。 不幸的是，條形圖沒有更新。 它停留在選擇的第一個變量上。

我嘗試創建觀察者函數來更新條形圖，但無濟於事。 我也試過在 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

正如我在評論中所寫，將反應式數據集作為參數傳遞給模塊服務器與傳遞任何其他類型的參數沒有什么不同。

這是一個 MWE，它說明了這個概念，在選擇模塊和顯示模塊之間傳遞mtcars或隨機值的數據幀。

關鍵點是選擇模塊將反應性[ data ] 而不是反應性值[ 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)