rshinyshinymodules

How to update shiny module with reactive dataframe from another module


The goal of this module is create a reactive barplot that changes based on the output of a data selector module. Unfortunately the barplot does not update. It's stuck at the first variable that's selected.

I've tried creating observer functions to update the barplot, to no avail. I've also tried nesting the selector server module within the barplot module, but I get the error: Warning: Error in UseMethod: no applicable method for 'mutate' applied to an object of class "c('reactiveExpr', 'reactive', 'function')"

I just need some way to tell the barplot module to update whenever the data it's fed changes.

Barplot Module:

#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 : Data Selector Module

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))
    )
    
  })
}

Simplified App

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)


Solution

  • As I wrote in my comment, passing a reactive dataset as an argument to a module server is no different to passing an argument of any other type.

    Here's a MWE that illustrates the concept, passing either mtcars or a data frame of random values between a selection module and a display module.

    The critical point is that the selection module returns the reactive [data], not the reactive's value [data()] to the main server function and, in turn, the reactive, not the reactive's value is passed as a parameter to the plot module.

    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)