时间戳

首页 > 解决方案 > 如何使用来自另一个模块的反应数据框更新闪亮的模块

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

问题描述

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

我尝试创建观察者函数来更新条形图，但无济于事。我也尝试将选择器服务器模块嵌套在 barplot 模块中，但我收到错误：警告：UseMethod 中的错误：没有适用于类“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)

标签： rshinyshinymodules

解决方案

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

这是一个说明概念的 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)

推荐阅读