Reactive input to shiny module - r

Question

Cross-posted from https://community.rstudio.com/t/reactive-input-to-module/143679, if that's not okay feel free to let me know! I'm new to posting here.
I'm using a module to handle file uploading. It allows the user to upload a CSV or an RDS, or to use the dataframe produced in a previous stage of the app. The call to the module takes the name of this previous dataframe as an argument, to know what to return if the user selects this option.
My issue is that this previous dataframe doesn't seem to update reactively. For one of the steps (we'll call it step 3), users can select whether they want to continue by using the dataframe from step 1, or from step 2. I've tried to code this by creating a server-side object, for_use_prev(), which stores the DF from step 1 if a checkbox is checked, and stores the DF from step 2 of the checkbox is unchecked. for_use_prev() is then called by the module.
The module call, however, does not update when for_use_prev() changes. It only takes the original value of the dataframe, and does not reset even when for_use_prev() changes. Clicking the upload button again also does not force it to take the new value of for_use_prev().
Why does the module call not change reactively to the reactive dataframe? I have tried various ways of calling it:
without parentheses:
loadFileServer("calc_input", prev_file=for_use_prev)
with parentheses:
loadFileServer("calc_input", prev_file=for_use_prev())
wrapped in reactive, with and without parentheses:
loadFileServer("calc_input", prev_file=reactive(for_use_prev()))
loadFileServer("calc_input", prev_file=reactive(for_use_prev))
None of them change the module output, although for_use_prev() itself is definitely changing. Additionally, when for_use_prev is called without parentheses as suggested here, the module returns the function behind for_use_prev rather than the dataframe.
Wrapping the whole module call in reactive() also does not work.
Does anyone have an idea how I can get the module call to react to changing input?
Below is a minimal example. To reproduce the issue, you can upload any two random CSV files in steps 1 and 2. In step 3, the current value of for_use_prev() is shown under "Current dataframe for_use_prev() is using". When you click the action button "Use file from previous step", the file upload module should output the same dataframe as for_use_prev() which will be displayed next to for_use_prev(). It does this for the first value of for_use_prev(), but if you uncheck the checkbox above the action button, you should be able to observe that for_use_prev() changes accordingly, but the value doesn't change from its initial one even as for_use_prev() changes.
EDIT: This is what it looks like when using the reactive (without parentheses) instead of its value (with parentheses).
The module returns the function rather than the dataframe.
I'm reluctant to change the module itself, since it's used multiple times throughout my app, and this is the only instance in which the user must be given a choice between two different previous DFs.
If more details or explanation are necessary please let me know!
Reprex:
library(shiny)
library(shinydashboard)
# Define the module
# Module UI function
loadFileUI <- function(id) {
# `NS(id)` returns a namespace function, which was save as `ns` and will
# invoke later.
ns <- NS(id)
tagList(
actionButton(ns("file_from_prev"),"Use file from previous step"),
h5("Or upload a saved file:"),
fileInput(ns("file_rds"), "RDS file",accept=".rds"),
fileInput(ns("file_csv"),"CSV File",accept=".csv"),
actionButton(ns("file_load_rds"),"Load RDS"),
actionButton(ns("file_load_csv"),"Load CSV"),
actionButton(ns("file_clear"),"Remove file upload")
)
}
# Module server function
loadFileServer <- function(id, prev_file) {
moduleServer(
id,
## Below is the module function
function(input, output, session) {
# initiate reactive values object to store what type of upload you want, or to clear your upload
upload_file <- reactiveValues(state=NULL)
observeEvent(input$file_from_prev,{ # take file from previous step
upload_file$state <- "prev"
})
observeEvent(input$file_load_rds,{ # load file from rds
upload_file$state <- "rds"
})
observeEvent(input$file_load_csv,{ # load file from csv
upload_file$state <- "csv"
})
observeEvent(input$file_clear,{ # clear file
upload_file$state <- "clear"
})
# actually upload the file (source depends on setting of upload_file$state as set above)
file_full <- reactive(
if(upload_file$state=="prev"){
prev_file
} else if(upload_file$state=="rds" & !is.null(input$file_rds)){
readRDS(input$file_rds$datapath)
} else if(upload_file$state=="csv" & !is.null(input$file_csv)){
read.csv(input$file_csv$datapath)
} else if(upload_file$state=="clear"){
NULL
}
)
# Return the reactive that yields the data frame
return(
list(df=(file_full),
status=reactive(upload_file$state))
)
}
)
}
# Set up the app
ui <- dashboardPage(
dashboardHeader(
title = "Reactive module input"
),
dashboardSidebar(
sidebarMenu(
menuItem("Step 1",tabName = "upload1"),
menuItem("Step 2",tabName = "upload2"),
menuItem("Step 3",tabName = "upload3")
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "upload1",
fileInput("file_up1",label = "Upload file",accept = ".csv"),
tableOutput("input1_preview")
),
tabItem(
tabName = "upload2",
fileInput("file_up2",label = "Upload file",accept = ".csv"),
tableOutput("input2_preview")
),
tabItem(
tabName = "upload3",
fluidRow(
column(width = 6,
box(width = NULL,
checkboxInput("which_prev_input","If checked, use input 1 as previous, otherwise input 2",value=T),
loadFileUI("step3_input")
)
)
),
fluidRow(
column(width = 6,
box(width = NULL,
title = "Current dataframe for_use_prev() is using",
tableOutput("prev_df_preview")
)
),
column(width = 6,
box(width = NULL,
title = "Dataframe being uploaded by the module",
tableOutput("step3_preview")
)
)
)
)
)
)
)
server <- function(input, output) {
# First file upload
upload1 <- reactive({
read.csv(input$file_up1$datapath)
})
output$input1_preview <- renderTable(upload1())
# Second file upload
upload2 <- reactive({
read.csv(input$file_up2$datapath)
})
output$input2_preview <- renderTable(upload2())
# Choose whether to use the first or second file
for_use_prev <- reactive({
if(input$which_prev_input){
upload1()
} else{
upload2()
}
})
# Call file upload module to give the possibility to upload a CSV, RDS, or use a previously uploaded file
upload_step3_raw <- loadFileServer("step3_input", prev_file=for_use_prev()) # the call to for_use_prev doesn't update
upload_step3_df <- reactive(upload_step3_raw$df())
# Preview the DF chosen to be the previous dataframe (for_use_prev)
output$prev_df_preview <- renderTable(head(for_use_prev()))
# Preview the uploaded dataframe
output$step3_preview <- renderTable(head(upload_step3_df()))
}
shinyApp(ui, server)
sessionInfo:
R version 4.2.1 (2022-06-23 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19042)
Matrix products: default
locale:
[1] LC_COLLATE=English_Germany.utf8 LC_CTYPE=English_Germany.utf8 LC_MONETARY=English_Germany.utf8
[4] LC_NUMERIC=C LC_TIME=English_Germany.utf8
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] shinydashboard_0.7.2 shiny_1.7.1
loaded via a namespace (and not attached):
[1] Rcpp_1.0.8 jquerylib_0.1.4 bslib_0.3.1 later_1.3.0 pillar_1.7.0 compiler_4.2.1
[7] plyr_1.8.6 bitops_1.0-7 tools_4.2.1 digest_0.6.29 jsonlite_1.7.3 lifecycle_1.0.1
[13] tibble_3.1.6 gtable_0.3.0 pkgconfig_2.0.3 rlang_1.0.1 cli_3.1.1 DBI_1.1.2
[19] fastmap_1.1.0 dplyr_1.0.8 httr_1.4.2 xml2_1.3.3 sass_0.4.0 generics_0.1.2
[25] vctrs_0.3.8 htmlwidgets_1.5.4 grid_4.2.1 tidyselect_1.1.2 fontawesome_0.2.2 reshape_0.8.8
[31] glue_1.6.2 data.table_1.14.2 R6_2.5.1 fansi_1.0.2 purrr_0.3.4 ggplot2_3.3.5
[37] magrittr_2.0.3 promises_1.2.0.1 scales_1.1.1 ellipsis_0.3.2 htmltools_0.5.2 assertthat_0.2.1
[43] rvest_1.0.2 xtable_1.8-4 mime_0.12 colorspace_2.0-2 httpuv_1.6.5 utf8_1.2.2
[49] munsell_0.5.0 RCurl_1.98-1.6 cachem_1.0.6 crayon_1.5.0

Answer 1

I'm not entirely clear what you are trying to do, and your reprex contained many small errors (most notably the incorrect definition of the return value from the upload server function and confusion between a reactive function (myReactive) and its current value (myReactive()), but this is my best guess at what you want.
On the Step 3 tab:
The left hand box ("Current dataframe for_use_prev() is using") updates depending on whether the "If checked ..." chekbox is checked or not
The right hand box is initially empty
The right hand box displays the same data as the left hand box when the "use file from previous step" button is clicked and updates in response to checking and unchecking the "If checked..." checkbox
The right hand box displays different data to the right hand box once the "Load CSV" button is clicked after loading a third scv file in the "CSV file" fileInput.
The right hand checkbox is empty after the "remove file upload" button is checked.
I believe all I have done is implement the changes I indicated were necessary in my original comment.
library(shiny)
library(shinydashboard)
# Define the module
# Module UI function
loadFileUI <- function(id) {
# `NS(id)` returns a namespace function, which was save as `ns` and will
# invoke later.
ns <- NS(id)
tagList(
actionButton(ns("file_from_prev"),"Use file from previous step"),
h5("Or upload a saved file:"),
fileInput(ns("file_rds"), "RDS file",accept=".rds"),
fileInput(ns("file_csv"),"CSV File",accept=".csv"),
actionButton(ns("file_load_rds"),"Load RDS"),
actionButton(ns("file_load_csv"),"Load CSV"),
actionButton(ns("file_clear"),"Remove file upload")
)
}
# Module server function
loadFileServer <- function(id, prev_file) {
moduleServer(
id,
## Below is the module function
function(input, output, session) {
# initiate reactive values object to store what type of upload you want, or to clear your upload
upload_file <- reactiveValues(state=NULL)
observeEvent(input$file_from_prev,{ # take file from previous step
upload_file$state <- "prev"
})
observeEvent(input$file_load_rds,{ # load file from rds
upload_file$state <- "rds"
})
observeEvent(input$file_load_csv,{ # load file from csv
upload_file$state <- "csv"
})
observeEvent(input$file_clear,{ # clear file
upload_file$state <- "clear"
})
# actually upload the file (source depends on setting of upload_file$state as set above)
file_full <- reactive(
if(upload_file$state=="prev"){
prev_file()
} else if(upload_file$state=="rds" & !is.null(input$file_rds)){
readRDS(input$file_rds$datapath)
} else if(upload_file$state=="csv" & !is.null(input$file_csv)){
read.csv(input$file_csv$datapath)
} else if(upload_file$state=="clear"){
NULL
}
)
rv <- reactive({
req(input$file_from_prev)
list(df=file_full(), status=upload_file$state)
})
# Return the reactive that yields the data frame
return(rv)
}
)
}
# Set up the app
ui <- dashboardPage(
dashboardHeader(
title = "Reactive module input"
),
dashboardSidebar(
sidebarMenu(
menuItem("Step 1",tabName = "upload1"),
menuItem("Step 2",tabName = "upload2"),
menuItem("Step 3",tabName = "upload3")
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "upload1",
fileInput("file_up1",label = "Upload file",accept = ".csv"),
tableOutput("input1_preview")
),
tabItem(
tabName = "upload2",
fileInput("file_up2",label = "Upload file",accept = ".csv"),
tableOutput("input2_preview")
),
tabItem(
tabName = "upload3",
fluidRow(
column(width = 6,
box(width = NULL,
checkboxInput("which_prev_input","If checked, use input 1 as previous, otherwise input 2",value=T),
loadFileUI("step3_input")
)
)
),
fluidRow(
column(width = 6,
box(width = NULL,
title = "Current dataframe for_use_prev() is using",
tableOutput("prev_df_preview")
)
),
column(width = 6,
box(width = NULL,
title = "Dataframe being uploaded by the module",
tableOutput("step3_preview")
)
)
)
)
)
)
)
server <- function(input, output) {
# First file upload
upload1 <- reactive({
req (input$file_up1)
read.csv(input$file_up1$datapath)
})
output$input1_preview <- renderTable(upload1())
# Second file upload
upload2 <- reactive({
req (input$file_up2)
read.csv(input$file_up2$datapath)
})
output$input2_preview <- renderTable(upload2())
# Choose whether to use the first or second file
for_use_prev <- reactive({
if(input$which_prev_input){
upload1()
} else{
upload2()
}
})
# Call file upload module to give the possibility to upload a CSV, RDS, or use a previously uploaded file
upload_step3_raw <- loadFileServer("step3_input", prev_file=for_use_prev) # the call to for_use_prev doesn't update
upload_step3_df <- reactive({ upload_step3_raw()$df })
# Preview the DF chosen to be the previous dataframe (for_use_prev)
output$prev_df_preview <- renderTable(head(for_use_prev()))
# Preview the uploaded dataframe
output$step3_preview <- renderTable({
req(upload_step3_df())
head(upload_step3_df())
})
}
shinyApp(ui, server)
You may very well have to change the module because the way you defined its return value was, I believe, fundamentally incorrect because the original definition did not allow other parts of the app to respond reactively.
One way of avoiding this situation arising in the future is to thoroughly test that the way the module is behaving is correct before beginning to use it in many different places within your app.
Welcome to SO.