diff --git a/thinkCausal/R/fct_popup.R b/thinkCausal/R/fct_popup.R index 496b5d0..bbb5e19 100644 --- a/thinkCausal/R/fct_popup.R +++ b/thinkCausal/R/fct_popup.R @@ -111,6 +111,33 @@ show_popup_learn_common_support <- function(session){ show_popup(session = session, content) } +show_popup_variable_selection_warning <- function(x, session, ns){ + content <- tags$div( + style = 'margin: auto; text-align: left', + h5(glue::glue('Currently, there are {x} avalable covaraites not included in the analysis.')), + h5('For observational studies in thinkCausal, include all pre-treatment variables in the analysis.'), + h5('The only reasons you should exclude a variable from the analysis are:'), + h5(' 1. The variable is a post-treatment variable (the variable could be effected by the treatment)'), + h5(' 2. The variable is an ID variable.'), + br(), + div( + class = 'backNextContainer', + style = "width:60%;display:inline-block;horizontal-align:center;", + actionButton(inputId = ns('analysis_model_variable_selection_popup_stop'), + class = 'nav-path', + label = 'Stay on page and update variable selection'), + actionButton(inputId = ns('analysis_model_variable_selection_popup_continue'), + class = 'nav-btn-focus', + label = glue::glue('Continue: All {x} variables are either post-treatment variables or ID variables')), + actionButton(inputId = ns('analysis_model_variable_selection_popup_posttreatment'), + class = 'nav-btn-focus', + label = 'Learn more about post-treatment variables') + ) + ) + show_popup(session = session, content, size = 'l') + +} + show_popup_model_no_estimand_warning <- function(session, ns){ content <- tags$div( style = 'margin: auto; text-align: center', diff --git a/thinkCausal/R/mod_analysis_variable_selection.R b/thinkCausal/R/mod_analysis_variable_selection.R index d0b167a..c84ecd1 100644 --- a/thinkCausal/R/mod_analysis_variable_selection.R +++ b/thinkCausal/R/mod_analysis_variable_selection.R @@ -404,8 +404,31 @@ mod_analysis_variable_selection_server <- function(id, store){ # create new dataframe when user saves column assignments and move to next page observeEvent(input$analysis_select_button_columnAssignSave, { - req(store$analysis_data_uploaded_df) + # launch popup if a lot of predictors are not included + pass_variable <- length(input$analysis_select_dragdrop_avalable) == 0 + if (isFALSE(pass_variable)) { + show_popup_variable_selection_warning(x = length(input$analysis_select_dragdrop_avalable), + session, ns = ns) + + observeEvent(input$analysis_model_button_popup, { + close_popup(session = session) + bs4Dash::updateTabItems(store$session_global, inputId = 'sidebar', selected = 'analysis_upload') + # updateNavbarPage(store$session_global, inputId = "nav", selected = module_ids$analysis$upload) + }) + + observeEvent(input$analysis_model_variable_selection_popup_posttreatment, { + close_popup(session = session) + store$analysis_origin <- 'analysis_select' + bs4Dash::updateTabItems(store$session_global, inputId = 'sidebar', selected = 'learn_post_treatment') + }) + + } + + validate(need(pass_variable, "")) + + + # remove any previous dataframes from the store store <- remove_downstream_data(store, page = 'select') diff --git a/thinkCausal/R/mod_learn_post_treatment.R b/thinkCausal/R/mod_learn_post_treatment.R index 808709e..6052fa2 100644 --- a/thinkCausal/R/mod_learn_post_treatment.R +++ b/thinkCausal/R/mod_learn_post_treatment.R @@ -72,6 +72,7 @@ mod_learn_post_treatment_ui <- function(id){ br(), br(), br(), + uiOutput(ns('analysis_return')), includeMarkdown(app_sys("app", "www", "learn", "post-treatment", "markdowns", 'post_treatment_citations.md')), includeMarkdown(app_sys("app", "www", "learn", "post-treatment", "markdowns", 'post_treatment_learn_more.md')) ) @@ -87,6 +88,21 @@ mod_learn_post_treatment_server <- function(id, store){ moduleServer( id, function(input, output, session){ ns <- session$ns + output$analysis_return <- renderUI({ + req(store$analysis_origin) + if(store$analysis_origin == 'analysis_select'){ + actionButton(ns('analysis_return'), label = 'Return to Analysis', class = 'nav-path') + + }else{ + NULL + } + }) + + observeEvent(input$analysis_return, { + bs4Dash::updateTabItems(store$session_global, inputId = 'sidebar', selected = 'analysis_variable_selection') + store$analysis_origin <- NULL + }) + # run the quiz mod_quiz_server( id = "quiz", # this should always be quiz