R Shiny module not updating reactively within same event - r

I'm having an issue with reactivity when using modules in R. If I update a module and then try to update another module with those updated values, I instead get the values prior to the update.
I've written up some basic code to show what I mean below. Here I have an app that updates a rHandsontableOutput placed in a module called my_module and then copies this updated rHandsontableOutput to a second module called module_to_update when a button is pressed.
What I'm finding is that the first table in my_module will update but not the one in module_to_update. Instead, the module_to_update table will receive a copy of my_module's initial table prior to the update. If I press the update button again, things work as expected.
I'm guessing this is an issue with either how I'm handling the session or reactive values generally, but I'm out of ideas.
QUESTION: How can I set up reactive values and modules such that I can run operations on updated module data within the same function call? (e.g. see the observeEvent(input$update_btn, ...) call below for an example)
Image:
application.R
library(shiny)
library(rhandsontable)
source('my_modules.R')
active_tab = ""
ui <- navbarPage("Module Test Tool",
tabsetPanel(id = 'mainTabset',
tabPanel("My Tab",
#This is the HoT that works as expected, updating when called upon
h4("Table 1"),
myModuleUI('my_module'),
#This is the HoT that does NOT work as expected. This HoT fails to use the updated values from 'my_module' HoT
h4("Table to be updated"),
myModuleUI('module_to_update'),
br(),
br(),
fluidRow(
#this button updates tables to new values
actionButton("update_btn", "Update and Add Tables"),
br(),
br(),
textOutput('table1_sum'),
textOutput('table2_sum'),
br(),
br()
)
)
)
)
server <- function(input, output, session) {
#Link logic for tab module
callModule(myModule, 'my_module')
#This button sums up all the rHandsonTable data frames
observeEvent(input$update_btn, {
#Update values in table and integer drop down list before doing basic operations on them
#New values should be all 5s
five_col = rep(5,3)
callModule(updateModule, 'my_module', 5, data.frame(col1 = five_col,
col2 = five_col,
col3 = five_col))
#Grabs updated module table and does operations on it
module_data = callModule(getMyModuleData, 'my_module')
module_int= module_data$module_int
module_df = module_data$module_df
output$table1_sum = renderText({
paste0("Sum of Table 1 is: ", sum(module_df())," | The selected integer is: ", module_int())
})
#------------------------------------------------------
#------------------ERROR BELOW-------------------------
#------------------------------------------------------
#THIS IS THE CODE THAT FAILS. This updates a 2nd module that should mirror the updated values. However, this results in old values.
callModule(updateModule, 'module_to_update', module_int(), module_df())
#Tries to call on new, updated table
updated_module_data = callModule(getMyModuleData, 'module_to_update')
updated_module_int= updated_module_data$module_int
updated_module_df = updated_module_data$module_df
#Display results of basic operations on new table
output$table2_sum = renderText({
paste0("Sum of Updated Table is: ", sum(updated_module_df())," | The selected integer is: ", updated_module_int())
})
})
}
## Create Shiny app ----
shinyApp(ui, server)
my_modules.R
#Simple module containing one rHandsontable and a drop down list of integers
myModuleUI <- function(id,tab_name){
ns <- NS(id)
fluidRow(
rHandsontableOutput(ns("module_hot")),
selectInput(ns('module_int_list'),"Integers:",c(1:5), selected = 1)
)
}
#Initializes myModuleUI rHandsonTable with some values
myModule <- function(input, output, session) {
one_col = rep.int('VALUE AT INITIALIZATION',3)
df = data.frame(col1 = one_col,
col2 = one_col,
col3 = one_col)
output$module_hot <- renderRHandsontable({
rhandsontable(df, stretchH = "none", rowHeaders = NULL)
})
}
#Returns myModule data for use outside of the module
getMyModuleData <- function(input,output,session){
return (
list(
module_df = reactive({hot_to_r(input$module_hot)}),
module_int = reactive({input$module_int_list})
)
)
}
updateModule<- function(input,output,session, new_integer, new_dataframe){
if(!is.null(new_dataframe))
{
output$module_hot <- renderRHandsontable({
rhandsontable(new_dataframe, stretchH = "none", rowHeaders = NULL)
})
}
outputOptions(output, "module_hot", suspendWhenHidden = FALSE)
updateSelectInput(session, "module_int_list",selected = new_integer)
}

There are a few problems in here...
You are calling multiple different modules with the same namespace. Modules are supposed to operate independently of each other. They should each have their own namespace. The following are not correct:
callModule(myModule, 'my_module')
callModule(updateModule, 'my_module', 5, data.frame(col1 = five_col,
col2 = five_col,
col3 = five_col))
module_data = callModule(getMyModuleData, 'my_module')
You are calling modules from within observeEvent(). This means every time you observe that event you try to initialize that module. You don't want to initialize the module, you want to pass the new variables to that module. If you make a module return it's values, then use those returned values as inputs into another module you won't need to observe the event...the module that receives the new information will decide whether to observe the change.
You have created a function/module getMyModuleData that is only supposed to return data that is present in a different module. Instead you should have the other module return the data you want.
Check out: https://shiny.rstudio.com/articles/communicate-bet-modules.html.

Related

Use functions or loops to create shiny UI elements

I am creating a shiny app and realized I am repeating a particular UI element so I am wondering if there is a way to wrap this in a function and supply parameters to make it work in different cases. In my server file, I have
output$loss <- renderUI({
req(input$got)
if(input$got %in% Years) return(numericInput('got_snow', label = 'John Snow', value = NA))
if(!input$got %in% Years) return(fluidRow(column(3)))
})
and in the ui file, I have:
splitLayout(
cellWidths = c("30%","70%"),
selectInput('got', label = 'Select age', choices = c('',Years) , selected = NULL),
uiOutput("loss")
)
Since I find myself using these several times and only changing a few things in both the UI and server files, I wanted to wrap these in a function and use them as and when I please. I tried this for the server file
ui_renderer <- function(in_put, label, id){
renderUI({
req(input[[in_put]])
if(input[[in_put]] %in% Years) return(numericInput(id, label = label, value = NA))
if(!input[[in_put]] %in% Years) return(fluidRow(column(3)))
})
}
output$p_li <- ui_renderer(input='li', "Enter age", id="c_li")
and in my ui file, I put
uiOutput('c_li')
but it's not working. Any help is greatly appreciated.
I was unable to test your code since there was no minimal working example. I don't know if this is a typo in your example, but your are trying to render c_li, but your output is called p_li. Not sure how wrapping a render object in a standard function works, but I have done something similar using reactive values instead.
This is a minimal example using some of your terminology. It is not a working example, but an outline of the idea to my proposed solution.
# Set up the UI ----
ui <- fluidPage(
uiOutput("loss")
)
# Set up the server side ----
server <- function(input, output, session) {
# Let us define reactive values for the function inputs
func <- reactiveValues(
value <- "got",
label <- "select age",
id <- "xyz"
)
# Set up an observer for when any of the reactive values change
observeEvent({
func$value
func$label
func$id
}, {
# Render a new UI any time a reactive value changes
output[["loss"]] <- renderUI(
if (input[[func$value]] %in% years) {
numericInput(func$id, label = func$label, value = NA)
} else {
fluidRow(
column(3)
)
}
)
})
}
# Combine into an app ----
shinyApp(ui = ui, server = server)
The general idea is to define a set of reactive values and set up an observer that will render the UI every time one or more of the reactive values change. You can assign a new value to any of the reactive values using direct assignment, e.g. current$value <- "object_two". Making that change will update the UI using Shiny's reactive pattern, which means you only need to change one value to update the UI.

rHandsonTable module returning NULL when called from another tabPanel

I have an application that utilizes a rHandsonTableOutput (HoT) in a module that utilizes a tabPanel. While I can get other data from this module (e.g. selections made in a selectInput) for some reason I get a NULL when trying to get the HoT data. I made a very simple version of my code to show what I mean.
I've found a HoT data is accessible if I place the module in the same UI element. For some reason, if I put it in another tab in a tabPanel it fails to return the data. My sample code should show that here.
UPDATE - I found the module will work so long as I click on and load the tab with the problematic HoT first! Something about "viewing" the tab first seems to fix this problem. I'd love to find a way to not need to do that. Is this related to rshiny "sessions"?
Below is the code that should reproduce the error. You'll find a simple application with two HoTs. The main tab has one put in via module myModuleUI. There's a second drop down tab that contains a second HoT generated via a second module myModuleTabUI. They're identical except that myModuleTabUI places everything in a tabPanel. If you press the "Add Table Button" it simply adds up the numbers in the tables but will fail when trying to do so for the HoT with ID first_tab (i.e. the HoT found in another tab).
This contains the main shiny app
application.R
library(shiny)
library(rhandsontable)
source('my_modules.R')
ui <- navbarPage("Module Test Tool",
tabsetPanel(id = 'mainTabset',
tabPanel("My Tab",
#This is the HoT that is accessible from a module
h4("Table 1"),
myModuleUI('my_module'),
br(),
br(),
fluidRow(
actionButton("sum_btn", "Add table data"),
br(),
br(),
textOutput('table1_sum'),
textOutput('table2_sum'),
br(),
br()
)
),
navbarMenu("My Module Tabs",
#This is the HoT that is inaccessible from a module
myModuleTabUI('first_tab', 'First')
)
)
)
server <- function(input, output, session) {
#Link logic for tab module
callModule(myModule, 'my_module')
callModule(myModuleTab, 'first_tab')
one_col = rep.int(1,3)
df = data.frame(col1 = one_col,
col2 = one_col,
col3 = one_col)
output$hot <- renderRHandsontable({
rhandsontable(df, stretchH = "none", rowHeaders = NULL)
})
#This button sums up all the rHandsonTable data frames
observeEvent(input$sum_btn, {
#Works just fine when not pulling from the same panel's module
module_data = callModule(getMyModuleData, 'my_module')
module_int= module_data$module_int
module_df = module_data$module_hot
output$table1_sum = renderText({
paste0("Sum of Table 1 is: ", sum(module_df)," | Integer one is: ", module_int)
})
#Fails when pulling a hands on table from another tab
module_tab_data = callModule(getMyModuleTabData, 'first_tab') #<---THIS LINE FAILS
module_tab_int= module_tab_data$module_tab_int
module_tab_df = module_tab_data$module_tab_hot
output$table2_sum = renderText({
paste0("Sum of the table in the 'First' tab is: ", sum(module_tab_df)," | Integer in 'First' tab is: ", module_tab_int)
})
})
}
## Create Shiny app ----
shinyApp(ui, server)
This file contains the modules used in this example:
my_modules.R
#Simple module containing one rHandsontable and a drop down list of integers
myModuleUI <- function(id,tab_name){
ns <- NS(id)
fluidRow(
rHandsontableOutput(ns("module_hot")),
selectInput(ns('module_int_list'),"Integers:",c(1:5), selected = 1)
)
}
#Initializes myModuleUI rHandsonTable with some values
myModule <- function(input, output, session) {
two_col = rep.int(2,3)
df = data.frame(col1 = two_col,
col2 = two_col,
col3 = two_col)
output$module_hot <- renderRHandsontable({
rhandsontable(df, stretchH = "none", rowHeaders = NULL)
})
}
#Returns myModule data for use outside of the module
getMyModuleData <- function(input,output,session){
return (
list(
module_hot = hot_to_r(input$module_hot),
module_int = input$module_int_list
)
)
}
#Simple module that adds the same as MyModuleUI, except in a tabPanel
myModuleTabUI <- function(id,tab_name){
ns <- NS(id)
tabPanel(tab_name,
fluidRow(
rHandsontableOutput(ns("module_tab_hot")),
selectInput(ns('module_tab_int_list'),"Integers:",c(1:5), selected = 1)
)
)
}
#Initializes myModuleTabUI rHandsonTable with some values
myModuleTab <- function(input, output, session){
three_col = rep.int(3,3)
df = data.frame(col1 = three_col,
col2 = three_col,
col3 = three_col)
output$module_tab_hot <- renderRHandsontable({
rhandsontable(df, stretchH = "none", rowHeaders = NULL)
})
}
#Returns MyModuleTab data for use outside of the module
getMyModuleTabData <- function(input,output,session){
return (
list(
module_tab_hot = hot_to_r(input$module_tab_hot), #<---THIS LINE FAILS
module_tab_int = input$module_tab_int_list
)
)
}
Please edit these lines:
#Fails when pulling a hands on table from another tab
module_tab_dat = callModule(getMyModuleTabData, 'first_tab') #<---THIS LINE FAILS
module_tab_int= module_tab_dat$module_tab_int
module_tab_df = module_tab_dat$module_tab_hot
You have:
module_tab_int= module_data$module_tab_int
module_tab_df = module_data$module_tab_hot
But you named the module module_tab_dat. Copy-paste error I assume.
Update
Regarding your update please add this line in your module code:
output$module_tab_hot <- renderRHandsontable({
rhandsontable(df, stretchH = "none", rowHeaders = NULL)
})
# Added line
outputOptions(output, "module_tab_hot", suspendWhenHidden = FALSE)
The aptly named suspendWhenHidden is TRUE by default as is probably correct for most use cases. In this case it must be FALSE. See here

Shiny R observeEvent with Multiple Conditions from selectInput

I'm working on a shiny app and I'm running into difficulty with observeEvent() function when creating a complex expression of multiple inputs that all derive from selectInput().
My issue is some of the expressions within the observeEvent() function are triggered at startup, causing the event to prematurely execute (i.e. my actionButton() is disabled at startup, as it should be, but becomes enabled when at least one of the inputs are selected when ideally I would want it to become enabled only when ALL inputs are selected). As seen below:
observeEvent({
#input$cohort_file
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}, {
enable("set_cohort_button")
})
For reference, I'm using the shinyjs package by #daattali found on github to enable/disable actionButton().
All but the last input (i.e. input$cohort_L0) appear to be initialized at startup so observeEvent() enables actionButton only when input$cohort_L0 is selected. If you run my app and select input in sequential order from top to bottom, it appears that observeEvent() is working as intended. I only discovered that it wasn't working as intended when I decided to choose inputs at random and discovered that selecting input$cohort_L0 was the only input I needed to select to enable actionButton().
The UI portion of the code looks like this:
# Variable selection
selectInput('cohort_IDvar', 'ID', choices = ''),
selectInput('cohort_index_date', 'Index date', choices = ''),
selectInput('cohort_EOF_date', 'End of follow-up date', choices = ''),
selectInput('cohort_EOF_type', 'End of follow-up reason', choices = ''),
selectInput('cohort_Y_name', 'Outcome', choices = ''),
selectInput('cohort_L0', 'Baseline covariate measurements', choices = '', multiple=TRUE, selectize=TRUE),
And I'm using observe() to collect the column names of an upload data-set to direct them to selectInput() as follows:
### Collecting column names of dataset and making them selectable input
observe({
value <- c("",names(cohort_data()))
updateSelectInput(session,"cohort_IDvar",choices = value)
updateSelectInput(session,"cohort_index_date",choices = value)
updateSelectInput(session,"cohort_EOF_date",choices = value)
updateSelectInput(session,"cohort_EOF_type",choices = value)
updateSelectInput(session,"cohort_L0",choices = value)
})
I've looked into using the argument ignoreInit = TRUE but it does nothing for my case of having multiple expressions within observeEvent(). I've also looked into forcing no default selection in selectInput() but had no luck with that.
So my two-part question is how can I execute observEvent() when only ALL inputs are selected/how do I stop from the inputs from being initialized at startup?
My entire code:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage("Test",
tabPanel("Cohort",
sidebarLayout(
sidebarPanel(
fileInput("cohort_file", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Variable selection
selectInput('cohort_IDvar', 'ID', choices = ''),
selectInput('cohort_index_date', 'Index date', choices = ''),
selectInput('cohort_EOF_date', 'End of follow-up date', choices = ''),
selectInput('cohort_EOF_type', 'End of follow-up reason', choices = ''),
selectInput('cohort_Y_name', 'Outcome', choices = ''),
selectInput('cohort_L0', 'Baseline covariate measurements', choices = '', multiple=TRUE, selectize=TRUE),
# Horizontal line ----
tags$hr(),
disabled(
actionButton("set_cohort_button","Set cohort")
)
#actionButton("refresh_cohort_button","Refresh")
),
mainPanel(
DT::dataTableOutput("cohort_table"),
tags$div(id = 'cohort_r_template')
)
)
)
)
)
server <- function(input, output, session) {
################################################
################# Cohort code
################################################
cohort_data <- reactive({
inFile_cohort <- input$cohort_file
if (is.null(inFile_cohort))
return(NULL)
df <- read.csv(inFile_cohort$datapath,
sep = ',')
return(df)
})
rv <- reactiveValues(cohort.data = NULL)
rv <- reactiveValues(cohort.id = NULL)
rv <- reactiveValues(cohort.index.date = NULL)
rv <- reactiveValues(cohort.eof.date = NULL)
rv <- reactiveValues(cohort.eof.type = NULL)
### Creating a reactiveValue of the loaded dataset
observeEvent(input$cohort_file, rv$cohort.data <- cohort_data())
### Displaying loaded dataset in UI
output$cohort_table <- DT::renderDataTable({
df <- cohort_data()
DT::datatable(df,options=list(scrollX=TRUE, scrollCollapse=TRUE))
})
### Collecting column names of dataset and making them selectable input
observe({
value <- c("",names(cohort_data()))
updateSelectInput(session,"cohort_IDvar",choices = value)
updateSelectInput(session,"cohort_index_date",choices = value)
updateSelectInput(session,"cohort_EOF_date",choices = value)
updateSelectInput(session,"cohort_EOF_type",choices = value)
updateSelectInput(session,"cohort_L0",choices = value)
})
### Creating selectable input for Outcome based on End of Follow-Up unique values
observeEvent(input$cohort_EOF_type,{
updateSelectInput(session,"cohort_Y_name",choices = unique(cohort_data()[,input$cohort_EOF_type]))
})
### Series of observeEvents for creating vector reactiveValues of selected column
observeEvent(input$cohort_IDvar, {
rv$cohort.id <- cohort_data()[,input$cohort_IDvar]
})
observeEvent(input$cohort_index_date, {
rv$cohort.index.date <- cohort_data()[,input$cohort_index_date]
})
observeEvent(input$cohort_EOF_date, {
rv$cohort.eof.date <- cohort_data()[,input$cohort_EOF_date]
})
observeEvent(input$cohort_EOF_type, {
rv$cohort.eof.type <- cohort_data()[,input$cohort_EOF_type]
})
### ATTENTION: Following eventReactive not needed for example so commenting out
### Setting id and eof.type as characters and index.date and eof.date as Dates
#cohort_data_final <- eventReactive(input$set_cohort_button,{
# rv$cohort.data[,input$cohort_IDvar] <- as.character(rv$cohort.id)
# rv$cohort.data[,input$cohort_index_date] <- as.Date(rv$cohort.index.date)
# rv$cohort.data[,input$cohort_EOF_date] <- as.Date(rv$cohort.eof.date)
# rv$cohort.data[,input$cohort_EOF_type] <- as.character(rv$cohort.eof.type)
# return(rv$cohort.data)
#})
### Applying desired R function
#set_cohort <- eventReactive(input$set_cohort_button,{
#function::setCohort(data.table::as.data.table(cohort_data_final()), input$cohort_IDvar, input$cohort_index_date, input$cohort_EOF_date, input$cohort_EOF_type, input$cohort_Y_name, input$cohort_L0)
#})
### R code template of function
cohort_code <- eventReactive(input$set_cohort_button,{
paste0("cohort <- setCohort(data = as.data.table(",input$cohort_file$name,"), IDvar = ",input$cohort_IDvar,", index_date = ",input$cohort_index_date,", EOF_date = ",input$cohort_EOF_date,", EOF_type = ",input$cohort_EOF_type,", Y_name = ",input$cohort_Y_name,", L0 = c(",paste0(input$cohort_L0,collapse=","),"))")
})
### R code template output fo UI
output$cohort_code <- renderText({
paste0("cohort <- setCohort(data = as.data.table(",input$cohort_file$name,"), IDvar = ",input$cohort_IDvar,", index_date = ",input$cohort_index_date,", EOF_date = ",input$cohort_EOF_date,", EOF_type = ",input$cohort_EOF_type,", Y_name = ",input$cohort_Y_name,", L0 = c(",paste0(input$cohort_L0,collapse=","),"))")
})
### Disables cohort button when "Set cohort" button is clicked
observeEvent(input$set_cohort_button, {
disable("set_cohort_button")
})
### Disables cohort button if different dataset is loaded
observeEvent(input$cohort_file, {
disable("set_cohort_button")
})
### This is where I run into trouble
observeEvent({
#input$cohort_file
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}, {
enable("set_cohort_button")
})
### Inserts heading and R template code in UI when "Set cohort" button is clicked
observeEvent(input$set_cohort_button, {
insertUI(
selector = '#cohort_r_template',
ui = tags$div(id = "cohort_insertUI",
h3("R Template Code"),
verbatimTextOutput("cohort_code"))
)
})
### Removes heading and R template code in UI when new file is uploaded or when input is changed
observeEvent({
input$cohort_file
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}, {
removeUI(
selector = '#cohort_insertUI'
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The code chunk that you're passing to the observeEvent as the trigger event is
{
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}
This means that, just like any other reactive code block, when ANY of these values changes, that reactive block is considered invalidated and therefore the observer will trigger. So the behaviour you're seeing makes sense.
It sounds like what you want is to execute only when all values are set. That sounds like a great use of the req() function! Try something like this:
observe({
req(input$cohort_IDvar, input$cohort_index_date, input$cohort_EOF_date, ...)
enable("set_cohort_button")
})
Note that for shinyjs::enable() specifically, you can instead use the shinyjs::toggleState() function. I think in this case the req() function is the better option though.

Make an eventReactive execute within a Shiny module

I have a selectInput UI object and I would like, once that is used to select an entry from the drop-down choices, to read an RDS file. The selectInput's choices are paths to different RDS files. The UI module works fine but the server one doesn't. I get input$study and hence input$dataset1, and then once I select an entry from input$datasets1 the app should start reading the RDS file but it doesn't.
How do I trigger the eventReactive expression inside the module to run and then make that RDS file available to the whole app for other modules to use?
load_sce <- function(input, output, session) {
output$sce_objects <- renderUI({
validate(need(input$study, message = FALSE))
withProgress(message = "Getting SCE objects...", {
objects <- FIND SOME FILES
ns <- session$ns
selectInput(inputId = ns("dataset1"),
label = "Select a specifc analysis",
width = "100%",
choices = c("", objects),
selected = "")
})
})
sce1 <- eventReactive(input$dataset1, {
validate(need(input$dataset1, message = FALSE))
withProgress(message = "Reading data...", { readRDS(input$dataset1) })
})
return( reactive({ sce1 }) )
}
I would review the documentation for withProgress and Progress. withProgress is for tasks operating inside of a loop. https://shiny.rstudio.com/reference/shiny/1.2.0/Progress.html
Also, see this example of a module: https://shiny.rstudio.com/articles/modules.html. In order for the dataframe to be returned as a reactive value outside the module, it should be created as a reactive object inside the module and then returned as such. Also, because input$dataset1 is the only reactive value that sce1 is dependent upon, reactive can be used instead of eventReactive. eventReactive is better suited for inputs such as buttons that are not actually used within the reactive expression, but simply server as the trigger for the expression to execute.
load_sce <- function(input, output, session) {
output$sce_objects <- renderUI({
validate(need(input$study, message = FALSE))
objects <- FIND SOME FILES
ns <- session$ns
selectInput(inputId = ns("dataset1"),
label = "Select a specifc analysis",
width = "100%",
choices = c("", objects),
selected = "")
})
sce1 <- reactive({
validate(need(input$dataset1, message = FALSE))
progress <- Progress$new(session, min=0, max=1)
on.exit(progress$close())
progress$set(message = 'Reading data...')
dataset1 <- readRDS(input$dataset1)
progress$set(value = 1)
return(df)
})
return(sce1)
}
SOLVED
I used the following in the module function:
sce1 <- reactive({
validate(need(input$dataset1, message = FALSE))
withProgress(message = "Reading data...", {
dataset1 <- readRDS(input$dataset1)
}) # withProgress
return(dataset1)
}) # reactive
return(sce1)
and called the module in the main app using:
sce1 <- callModule(load_sce, "load_sce_explore")
Now I can pass sce1 to other modules as a function argument (use sce1 not sce1()) or use it in other pieces of code in the main app (but in this case use sce1()).
Thanks

Shiny renderDataTable table_cell_clicked

I am trying to create a table using Shiny, where the user can click on a row in order to see further information about that row. I thought I understood how to do this (see code attached).
However, right now as soon as the user clicks the "getQueue" action button, the observeEvent(input$fileList_cell_clicked, {}) seems to get called. Why would this be called before the user even has the chance to click on a row? Is it also called when the table is generated? Is there any way around this?
I need to replace "output$devel <- renderText("cell_clicked_called")" with code that will have all sorts of errors if there isn't an actual cell to refer to.
Thank you for any advice!
ui <- fluidPage(
actionButton("getQueue", "Get list of queued files"),
verbatimTextOutput("devel"),
DT::dataTableOutput("fileList")
)
shinyServer <- function(input, output) {
observeEvent(input$getQueue, {
#get list of excel files
toTable <<- data.frame("queueFiles" = list.files("queue/", pattern = "*.xlsx")) #need to catch if there are no files in queue
output$fileList <- DT::renderDataTable({
toTable
}, selection = 'single') #, selection = list(mode = 'single', selected = as.character(1))
})
observeEvent(input$fileList_cell_clicked, {
output$devel <- renderText("cell_clicked_called")
})}
shinyApp(ui = ui, server = shinyServer)
minimal error code
DT initializes input$tableId_cell_clicked as an empty list, which causes observeEvent to trigger since observeEvent only ignores NULL values by default. You can stop the reactive expression when this list is empty by inserting something like req(length(input$tableId_cell_clicked) > 0).
Here's a slightly modified version of your example that demonstrates this.
library(shiny)
ui <- fluidPage(
actionButton("getQueue", "Get list of queued files"),
verbatimTextOutput("devel"),
DT::dataTableOutput("fileList")
)
shinyServer <- function(input, output) {
tbl <- eventReactive(input$getQueue, {
mtcars
})
output$fileList <- DT::renderDataTable({
tbl()
}, selection = 'single')
output$devel <- renderPrint({
req(length(input$fileList_cell_clicked) > 0)
input$fileList_cell_clicked
})
}
shinyApp(ui = ui, server = shinyServer)

Resources