new popup warning for variable selection

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',

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')

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