Cross-Posted on StackOverflow: https://stackoverflow.com/questions/61810312/make-use-of-reactive-return-from-same-shiny-module-multiple-times-with-different
I have created a sample app below to illustrate the issue I am having. There are two tabs(Adverse Event,Concomitant Medications) calling the selectbutton function. Each tab could switch to the combined tab passing the reactive return and display the corresponding integrated output.
My question is how to pass the most update reactive return(vals$id_source_select) to the vals$id_source_select_all? For example, I first pass the reactive from AE to the combined tab then how to update the integrated output when I want to pass the reactive from CM?
I feel like I am missing a fundamental trick to making this work. I would really appreciate the learning experience and all of the help.
UI.R
dashboardPage(
dashboardHeader(
title = "Test"),
dashboardSidebar(
sidebarMenu(
id="tabs",
menuItem("Data Explorer", icon=icon("signal"),tabName="table",
menuSubItem('Adverse Event Table',tabName="ae_t"),
menuSubItem('Concomitant Medications Table',tabName="cm_t"),
menuSubItem('Combined Table',tabName="comb_t")
)
)
),
dashboardBody(
tabItem(tabName="ae_t",
selectbutton_UI("ae", "Adverse Event")
),
# third tab content
tabItem(tabName="cm_t",
selectbutton_UI("cm", "Concomitant Medications")
),
tabItem(tabName="comb_t",
fluidrow(
column(width = 4,
actionButton("Submit", "Submit"),
#compute adverse event
box(collapsible = TRUE,status = "success",solidHeader = TRUE,
width=12, title="Adverse Events",
DT::dataTableOutput("ae")
),
#compute concomitant medications
box(collapsible = TRUE,status = "success",solidHeader = TRUE,
width=12, title="Concomitant Medications",
DT::dataTableOutput("cm")
),
)
) #dashboardBody
) #dashboardpage
Sever.R
shinyServer(function(input, output, session) {
vals <- reactiveValues(
id_source_select_all=NULL,
# id_source_select_ae=NULL,
# id_source_select_cm=NULL,
id_table_select=NULL,
)
id_source_select_ae <- callModule(selectbutton,
"ae",
ae_s,
c("USUBJID","COUNTRYDC","SITEID" ,"AETERM", "AEDECOD", "AESTDTC", "AEENDTC", "AEOUT","AECONTRT" ,"AESEV", "AEACN", "AESER","AESDTH","AESLIFE","AESDISAB", "AESHOSP","AESCONG","AEREL"),
c("Subject ID","Country","Site", "Reported Term", "Dictionary-Derived Term", "Start Date", "End Date", "Outcome of Adverse Event", "Concomitant or Additional Trtmnt Given" ,"Severity/Intensity","Action Taken with Study Treat", "Serious Event",
"Death", "Life Threatening", "Significant Disability/Incapacity", "Requires or Prolongs Hospital", "Congenital Anomaly/Birth Defect", "Causality"),
"Adverse Event",
session
)
id_source_select_cm <- callModule(selectbutton,
"cm",
cm,
c("USUBJID","COUNTRYDC","SITEID", "CMTRT", "CMDECOD", "CMINDC", "CMINDC0", "CMSTDTC", "CMENDTC", "CMENRTPT", "CMDOSE", "CMDOSU", "CMDOSFRQ","CMROUTE"),
c("Subject ID","Country","Site", "Reported Name of Drug, Med, or Therapy", "Standardized Medication Name","Indication/Category","AE/BC Indication", "Start Date/Time of Medication", "End Date/Time of Medication", "End Relative to Reference Time Point", "Dose", "Dose Unit", "Frequency", "Route"),
"Concomitant Medications",
session
)
observe({
vals$id_source_select_all<-first(na.omit(c(id_source_select_ae(), id_source_select_cm())))
})
observeEvent(input$Submit,{
vals$id_table_select <- vals$id_source_select_all
})
#### Adverse Events####
output$ae<-DT::renderDataTable({
req(nrow(ae())>0)
req(vals$id_table_select)
DT::datatable(data=ae() %>% filter(USUBJID==vals$id_table_select & AETERM != "") %>% select(c(AETERM, AEDECOD, AESTDTC, AEENDTC, AEOUT,ACONTRT,ASEV, AACN, AESER,AESDTH,ASLIFE,AESDISAB, ASHOSP,AESCONG, AOTHSIG,ASIGN,AREL, ACOVAL)),
colnames=c("Reported Term", "Dictionary-Derived Term", "Start Date", "End Date", "Outcome of Adverse Event", "Concomitant or Additional Trtmnt Given" ,"Severity/Intensity","Action Taken with Study Treat", "Serious Event",
"Death", "Life Threatening", "Significant Disability/Incapacity", "Requires or Prolongs Hospital", "Congenital Anomaly/Birth Defect","Other Significant Event","AE of Special Interest", "Causality","Comment"),
filter = "top", options=list(paging=T, ordering=T, search = list(regex = T),scrollX = TRUE),rownames= FALSE)
})
#### Concomitant Medications ####
version<-reactive({cm() %>% filter(USUBJID==vals$id_table_select)})
text<-reactive({version() %>%select(WHOVER)})
whodrug<-reactive({text()[1,1]})
output$cm<-DT::renderDataTable({
req(nrow(cm())>0)
req(vals$id_table_select)
DT::datatable(data=cm() %>% filter(USUBJID==vals$id_table_select) %>% select(c(CMTRT, CMDECOD, CMINDC, CMINDC0, CMSTDTC, CMENDTC, CMENRTPT, CMDOSE, CMDOSU, CMDOSFRQ,CMROUTE)),colnames=c("Reported Name of Drug, Med, or Therapy", "Standardized Medication Name","Indication/Category","AE/BC Indication", "Start Date/Time of Medication", "End Date/Time of Medication", "End Relative to Reference Time Point", "Dose", "Dose Unit", "Frequency", "Route"),
filter = "top", options=list(paging=T, search = list(regex = T), ordering=T, scrollX = TRUE, lengthMenu = list(c(10, 50, 100, -1), c('10', '50', "100", 'All')))
, caption = paste("WHODRUG Version: ",as.character(whodrug())),rownames= FALSE)
})
})
modules.R
selectbutton_UI <- function(id,t_title) {
ns = NS(id)
fluidRow(
column(2,offset=0.5,
actionButton(ns('btn_switchtab'), 'Switch tab'),
downloadButton(ns("export"), "Download")),
box(collapsible = TRUE,status = "primary",solidHeader = TRUE,
width=12, title= t_title,
DT::dataTableOutput(ns("source_t"))
)
)
}
selectbutton <- function(input, output, session,data,select_var,col_names,title_f,parent_session) {
vals <- reactiveValues(id_source_select = NULL)
output$source_t<-DT::renderDataTable({
req(nrow(data())>0)
DT::datatable(data=data() %>% select(select_var),colnames = col_names,
filter = "top", options=list(paging=T, ordering=F, search = list(regex = T), scrollX = T , ordering=T), selection = "single",rownames= FALSE
)
})
output$export <- downloadHandler(
filename = function() {paste0(title_f, '.xlsx')},
content = function(file) {write_xlsx(data(), path = file)}
)
observeEvent(input$btn_switchtab, {
updateTabItems(session=parent_session, "tabs", selected= "comb_t")
})
observeEvent(input$btn_switchtab,{
req(nrow(data())>0)
vals$id_source_select <- as.character(data()[input$source_t_rows_selected,'USUBJID'])
# vals$trigger <- vals$trigger+1
})
return(reactive({vals$id_source_select}))
# return(vals$id_source_select)
}