How can I send and update reactive values from within a R Shiny module? - shiny

Question

I'm trying to write a module that gets a reactive dataframe as an input and allows the user to manipulate it (for the sake of the Minimal Reproducible Example, to add to the table a single row)
Initially, the data that being passed to the module from the main app is some default dataframe (hard coded in the MRE), so the module is always initiated with data.
In addition, I also want to allow the user to manipulate that data from outside the module (for the sake of the MRE, override the dataset with a different, hard-coded dataset).
I cannot make both functionalities in the MRE to work at the same time. At the moment, the update from main app works, but the update from within the module won't work. I found some solutions that would enable the opposite situation.
when trying to add row: no response and no error.
Note 1: The use of modules in the MRE is artificial and not really needed, but it is very much needed in the real app.
Note2: returning a new data frame instead of updating it is not ideal in my case as I would want to allow the user other manipulations, and only after all changes are done, to return the the new data frame.
Minimal Reproducible Example:
library(shiny)
library(tidyverse)
DEFAULT_DATA <- tribble(
~letter, ~number,
"A", 1,
"B", 2,
)
changeDataUI <- function(id) {
ns <- NS(id)
tagList(
tableOutput(ns("tbl"))
,br()
,actionButton(ns("add_row"), 'Add Row')
)
}
changeDataServer <- function(id, data) {
moduleServer(
id,
function(input, output, session) {
observeEvent(input$add_row, {
data <- data() %>% add_row(letter = "C", number = 3)
})
output$tbl <- renderTable(data())
}
)
}
ui <- fluidPage(
titlePanel("MRE App")
,fluidRow(column(6, actionButton("change_dataset", "Change Dataset")))
,fluidRow(column(6, changeDataUI("some_id")))
)
server <- function(input, output) {
glob_rvs <- reactiveValues(data = DEFAULT_DATA)
observeEvent(input$change_dataset, {
glob_rvs$data <- tribble(
~letter, ~number,
"D", 4,
"E", 5,
)
})
changeDataServer(id = "some_id", data = reactive(glob_rvs$data))
}
shinyApp(ui = ui, server = server)

Answer 1

With R, you typically want your modules to act as functional as possible. This, as you point out allows you to better reason about your app. I would have your module return the rows to be added and then have your top level app append them. Otherwise you module is essentially causing side effects. Also, this way your top level app (or another module) could coordinate multiple manipulations. The module could still show the data
Example implementation for module server:
changeDataServer <- function(id, data) {
moduleServer(
id,
function(input, output, session) {
additionalRows <- reactiveVal()
observeEvent(input$change, {
additionalRows(
data.frame(letter = sample(letters, 1) , number = runif(1, 0, 10))
)
})
output$tbl <- renderTable(data())
# return reactive with additional rows to allow to be merged at top level
additionalRows
}
)
}
Then update the server (also changed the input for the upload handler to match the UI (input$uploaded_data not input$uploaded_scheme)
server <- function(input, output) {
glob_rvs <- reactiveValues(data = DEFAULT_DATA)
observeEvent(input$uploaded_data, {
uploaded_data <- read_csv(input$uploaded_data$datapath)
glob_rvs$data <- uploaded_data
})
newRows <- changeDataServer(id = "some_id", data = reactive(glob_rvs$data))
observe({
glob_rvs$data <- bind_rows(glob_rvs$data, newRows())
}) %>%
bindEvent(newRows())
}

Answer 2

What you want to do here is to pass you reactiveValues object as an argument of your module server.
I advise you read this article about how to communicate data between modules
library(shiny)
library(tidyverse)
DEFAULT_DATA <- tribble(
~letter, ~number,
"A", 1,
"B", 2,
)
changeDataUI <- function(id) {
ns <- NS(id)
tagList(
tableOutput(ns("tbl"))
,br()
,actionButton(ns("change"), 'Add Row')
)
}
changeDataServer <- function(id, glob_rvs) {
moduleServer(
id,
function(input, output, session) {
observeEvent(input$change, {
print(glob_rvs$data)
glob_rvs$data <- glob_rvs$data %>% add_row(letter = "C", number = 3)
})
output$tbl <- renderTable(glob_rvs$data)
}
)
}
ui <- fluidPage(
titlePanel("MRE App")
,fluidRow(column(6,
fileInput("uploaded_data",
"would ypu like to upload your own data?",
multiple = FALSE,
accept = c(".csv"))))
,fluidRow(column(6, changeDataUI("some_id")))
)
server <- function(input, output) {
glob_rvs <- reactiveValues(data = DEFAULT_DATA)
observeEvent(input$uploaded_data, {
uploaded_data <- read_csv(input$uploaded_scheme$datapath)
glob_rvs$data <- uploaded_data
})
changeDataServer(id = "some_id", glob_rvs = glob_rvs)
}
shinyApp(ui = ui, server = server)

Answer 3

Following the solution by #Marcus, here is a working version that is consistent with the last version of post:
library(shiny)
library(tidyverse)
DEFAULT_DATA <- tribble(
~letter, ~number,
"A", 1,
"B", 2,
)
changeDataUI <- function(id) {
ns <- NS(id)
tagList(
tableOutput(ns("tbl"))
,br()
,actionButton(ns("add_row"), 'Add Row')
)
}
changeDataServer <- function(id, data) {
moduleServer(
id,
function(input, output, session) {
additionalRows <- reactiveVal()
observeEvent(input$add_row, {
additionalRows(
data.frame(letter = sample(letters, 1) , number = runif(1, 0, 10))
)
})
output$tbl <- renderTable(data())
# return reactive with additional rows to allow to be merged at top level
additionalRows
}
)
}
ui <- fluidPage(
titlePanel("MRE App")
,fluidRow(column(6, actionButton("change_dataset", "Change Dataset")))
,fluidRow(column(6, changeDataUI("some_id")))
)
server <- function(input, output) {
glob_rvs <- reactiveValues(data = DEFAULT_DATA)
observeEvent(input$change_dataset, {
glob_rvs$data <- tribble(
~letter, ~number,
"D", 4,
"E", 5,
)
})
newRows <- changeDataServer(id = "some_id", data = reactive(glob_rvs$data))
observe({
glob_rvs$data <- bind_rows(glob_rvs$data, newRows())
}) %>%
bindEvent(newRows())
}
shinyApp(ui = ui, server = server)