---
title: "NRBA Tool"
output:
  flexdashboard::flex_dashboard:
    vertical_layout: fill
    navbar:
      - title: "<img id='navbar_logo' src='img/logo.png' width=325>"
runtime: shiny
---

```{r setup, include=FALSE}
library(nrba)
library(dplyr)
library(survey)
library(shinyjs)
library(openxlsx)
enableBookmarking("server")
options(shiny.maxRequestSize=30*1024^2)
options(survey.lonely.psu = 'adjust')
options(survey.adjust.domain.lonely = TRUE)
```

```{r global, include=FALSE}

types <- read.csv(system.file("types.csv", package = "idcnrba"))
routines <- read.csv(system.file("routines.csv", package = "idcnrba"))
parameters <- read.csv(system.file("parameters.csv", package = "idcnrba"))
parameters_html_crosswalk <- read.csv(system.file("parameters_html_crosswalk.csv", package = "idcnrba"))
output_table_dictionary <- read.csv(system.file("output_table_dictionary.csv", package = "idcnrba"))
errors <- read.csv(system.file("errors.csv", package = "idcnrba"))
setup_module_checks <- read.csv(system.file("setup_module_checks.csv", package = "idcnrba"))

# removes excess spaces at the ends and beginnings of strings in csv's
types <- types %>% mutate_if(is.character, function(x) trimws(x))
routines <- routines %>% mutate_if(is.character, function(x) trimws(x))
parameters <- parameters %>% mutate_if(is.character, function(x) trimws(x))
parameters_html_crosswalk <- parameters_html_crosswalk %>% mutate_if(is.character, function(x) trimws(x))
output_table_dictionary <- output_table_dictionary %>% mutate_if(is.character, function(x) trimws(x))
errors <- errors %>% mutate_if(is.character, function(x) trimws(x))
setup_module_checks <- setup_module_checks %>% mutate_if(is.character, function(x) trimws(x)) 

analysis_store <<- list(`1` = list(), `2` = list(), `3` = list(), `4` = list(), `5` = list(), `6` = list(), `7` = list(), `8` = list(), `9` = list())
report_input_counter <<- 1
previous_report_input_counter <<- report_input_counter

global_values <- reactiveValues()
routine_name <<- NA
rotuine_label <<- NA
```

```{r, include=FALSE}
onBookmarked(function(url) {
  updateQueryString(url)
})
```

```{r tooltip_things, results='asis'}
tooltips <- read.csv(system.file("html_identifiers.csv", package = "idcnrba"))
tooltips_js_object <- paste0(
  "var nrba_tooltips = [",
  paste(paste0("['", tooltips$html_id, "',", "'", gsub("'", "\\\\'", tooltips$tooltip), "']"), collapse = ","),
  "];")
tags$script(HTML(tooltips_js_object))
```

```{r report_things, results='asis'}
cat("<div style=\"height: 0px; visibility: hidden\">")
htmlOutput(outputId = "report_link_container", container = div)
cat("</div>")
```

```{r helper_functions}
percent <- function(x, digits = 2) {
  if (digits < 2) {
    stop("'digits' must be at least '2'")
  }
  format <- paste0("%0.", digits - 2, "f%%")
  sprintf(format, round(x, digits = digits) * 100)
}

as_survey_formula <- function(x, ids = FALSE) {
  if (is.null(x) || all(nchar(x) == 0)) {
    if (ids) {
      return(~1)
    } else return(NULL)
  } else {
    return(as.formula(paste0("~", paste(x, collapse = "+"))))
  }
}

as_numeric_input <- function(x) {
  if (is.null(x) || all(nchar(x) == 0)) {
    return(NULL)
  } else if (suppressWarnings(is.na(as.numeric(x)))) {
    input_name <- deparse(substitute(x))
    stop(input_name, ": ", dQuote(x, F), " is not a numeric input.")
  } else {
    as.numeric(x)
  }
}

get_survey_design_object <- function(data, input, secondary_raked = FALSE) {

  if (input$sampling_weight_variable == "[No Weights]") {
    sampling_weight_variable_input <- NULL 
  } else {
    sampling_weight_variable_input <- input$sampling_weight_variable
  }
  
  if (secondary_raked) {
    
    rscales_input <- input$t5_raked_rscales %>%
      strsplit(",") %>%
      unlist() %>%
      lapply(as_numeric_input, USE.NAMES = F)
    
    if (length(rscales_input) == 0) rscales_input <- NULL
    
    survey_design <- svrepdesign(
      data = data,
      weights = as_survey_formula(sampling_weight_variable_input),
      repweights = select(data, input$t5_raked_replicate_weight_variables),
      type = input$t5_raked_replicate_weight_method,
      combined.weights = input$t5_raked_combined_weights,
      rho = as_numeric_input(input$t5_raked_rho),
      scale = as_numeric_input(input$t5_raked_scale),
      rscales = rscales_input
    )
    
  } else if (input$replicate_weights == "Yes") {
    
    rscales_input <- input$rscales %>%
      strsplit(",") %>%
      unlist() %>%
      lapply(as_numeric_input, USE.NAMES = F)
    
    if (length(rscales_input) == 0) rscales_input <- NULL
    
    survey_design <- svrepdesign(
      data = data,
      weights = as_survey_formula(sampling_weight_variable_input),
      repweights = select(data, input$replicate_weight_variables),
      type = input$replicate_weight_method,
      combined.weights = input$combined_weights,
      rho = as_numeric_input(input$rho),
      scale = as_numeric_input(input$scale),
      rscales = rscales_input
    )
    
  } else {
    if (input$data_collection_method == "Attempted Census") {
      survey_design <- svydesign(
        data = data,
        weights = as_survey_formula(sampling_weight_variable_input),
        ids = ~1,
        fpc = as_survey_formula(input$population_size_variables)
      )      
    } else {
      survey_design <- svydesign(
        data = data,
        weights = as_survey_formula(sampling_weight_variable_input),
        strata = as_survey_formula(input$strata_variables),
        ids = as_survey_formula(c(input$psu_cluster_variables,
                                  input$ssu_cluster_variables), 
                                ids = T),
        nest = TRUE,
        fpc = as_survey_formula(input$population_size_variables)
      )      
    }
  }

  if (input$sampling_weight_variable == "[No Weights]") {
    survey_design$prob <- rep(1, times = nrow(data))
  }

  return(survey_design)
}

analysisButton <- function(inputId, label, description = NA, info_link = "#") {
  fluidRow(
    column(actionButton(
      inputId = inputId,
      label = label, 
      description = description,
      class = "btn-analysis",
      width = "99%"
    ), width = 11, style = "padding-right: 0px;"),
    hidden(column(tags$a(
      id = paste(inputId, "info", sep = "_"), 
      icon("info-circle"),
      class = "action-button",
      style = "font-size: 16px; color: #1e857b;",
      href = info_link,
      target = "_blank"
    ), width = 1, style = "padding-left: 0px;")),
    style = "padding: .5px;"
  )  
}

# creates reactive add-to-report button
report_rv <- reactiveValues(report_add_button = FALSE)
output$report_add_button <- reactive({report_rv$report_add_button})
outputOptions(output, "report_add_button", suspendWhenHidden = FALSE)
# creates reactive add-to-report button
report_rv <- reactiveValues(report_remove_button = FALSE)
output$report_remove_button <- reactive({report_rv$report_remove_button})
outputOptions(output, "report_remove_button", suspendWhenHidden = FALSE)


render_analysis_output <- function(output_table) {
  
  most_recent_output_table <<- output_table
  renderUI({
    if("error" %in% class(output_table) | length(output_table) == 0) {
      error <- ""
      if (is.na(routine_name)) {
        error <- "Variable `routine_name` not set. Please see detailed R message below."
      } else {
        for (iterate_error in errors$errors[errors$routine_name == routine_name]) {
          error <- paste0(iterate_error, "<br><br>", error)
        }
      }
      modal_out <- modalDialog(
        h3("Error in analysis:", style = "font-color: red;"), 
        tags$p("Please check that the Setup module and the specific analysis options have been configured correctly. Below are some checks that may identify the source of the problem.\n", style = "font-weight: bold;"),
        HTML(paste0(error, "\n")),
        h3("Below is a more detailed error message from R", style = "font-color: red;"),
        tags$blockquote(output_table$message)
      )
    } else {
      
      column_dictionary <- output_table_dictionary %>%
        rename(routine_name_lookup = routine_name) %>% # names in global env and table cannot be the same when comparing
        filter(routine_name_lookup == routine_name) %>%
        filter(nchar(short_label) > 0) %>%
        mutate(label = sprintf("<span title='%s'>%s</span>", description, short_label))
  
      column_lookup <- column_dictionary$column_name
      names(column_lookup) <- column_dictionary$label
      column_lookup <- column_lookup[column_lookup %in% colnames(output_table)]
    
      # for (i in seq_along(output_table)) {
      #   attr(output_table[[i]], "original_column_name") <- colnames(output_table)[i]
      # }
      
      for(i in 1:ncol(output_table)){
        # only looks at output_dictionary with same routine name
        routine_dictionary <- output_table_dictionary[output_table_dictionary$routine_name == routine_name,]
        
        if (names(output_table)[i] %in% routine_dictionary$column_name){
          # if str is double then it is rounded to value in dictionary
          which_routine_dictionary_row <- which(routine_dictionary$column_name[routine_dictionary$routine_name == routine_name] == names(output_table)[i])
          precision_to_use <- routine_dictionary$precision[which_routine_dictionary_row]
          if (is.double(output_table[,i])) {
            output_table[,i] <- round(output_table[,i,drop=TRUE], digits = precision_to_use)
          } else if (nrow(as.data.frame(output_table[,i])) > 1){
            output_table <- as_tibble(output_table)
            if (is.numeric(output_table[[i]])) {
              output_table[[i]] <- round(output_table[[i]], digits = precision_to_use)
            }
          }
          which_routine_dictionary_row <- which(routine_dictionary$column_name == names(output_table)[i])
          # checks if output column is labeled as percent
          is_percentage <- tolower(routine_dictionary$is_percentage[which_routine_dictionary_row])
          is_percentage <- ifelse(is.na(is_percentage), "no", is_percentage)
          if (is_percentage == "yes") {
            output_table[,i] <- percent(output_table[,i,drop=TRUE], precision_to_use)
          }
          if (is_percentage == "maybe") {
            col_to_check <- routine_dictionary$percent_determiner[which_routine_dictionary_row]
            if (col_to_check %in% colnames(output_table)) {
              for (row_index in seq_len(nrow(output_table))) {
                if ((!is.na(output_table[[col_to_check]][row_index])) & (output_table[[col_to_check]][row_index] != "")) {
                  output_table[[i]][row_index] <- percent(as.numeric(output_table[[i]][row_index]), precision_to_use)
                }
              }
            }
          }
        }
      }
      
      most_recent_output_table <<- output_table
      set_action_button()
      modal_out <- modalDialog(size = "l",
        DT::renderDT({
           DT::datatable(
            data = output_table,
            colnames = colnames(rename(output_table, column_lookup)),
            escape = FALSE,
            extensions = "Scroller",
            class = "compact",
            selection = 'none',
            options = list(
              dom = "t",
              ordering = FALSE,
              scrollX = TRUE,
              #scrollY = 250,
              scrollCollapse = TRUE,
              scroller = TRUE
            )
          ) %>% DT::formatStyle(columns = column_dictionary[column_dictionary$is_emphasized == "Yes" & column_dictionary$column_name %in% colnames(output_table),"column_name"], fontWeight = 'bold')         
        }),
        HTML(ifelse(is.null(footer_value), "", footer_value)),
        conditionalPanel(
          condition = "output.report_remove_button == true",
          br(),
          fluidRow (
            align = "right",
            actionButton("remove_from_report", "Remove"),
            modalButton("Close")
          )
        ),
        conditionalPanel(
          condition = "output.report_add_button == true",
          br(),
          fluidRow (
            align = "right",
            actionButton("add_to_report", "Add"),
            modalButton("Close")
          )
        ),
        footer = NULL
      )
    }
    return(modal_out)
  })  
}

set_action_button <- function() {
  type <- types$type[which(types$type_label == routine_label)]
  report_rv$report_remove_button <- FALSE
  report_rv$report_add_button <- TRUE
  # searches through the list of analysis methods and finds which matches the submitted param_list
  # if found, add and remove buttons are switched
  if (length(analysis_store[[type]]) > 0) {
    for (i in 1:length(analysis_store[[type]])) {
      if (length(analysis_store[[type]][[i]]) > 0) {
        if (identical(analysis_store[[type]][[i]][["param_list"]], param_list) == TRUE) {
          report_rv$report_remove_button <- TRUE
          report_rv$report_add_button <- FALSE
          break
        } 
      }
    }
  }
} 

observeEvent(input$add_to_report, {
  report_rv$report_add_button <- FALSE
  report_rv$report_remove_button <- TRUE
  type <- types$type[which(types$type_label == routine_label)]
  new_index <- length(analysis_store[[type]])+1
  parameters <- inner_join(parameters, parameters_html_crosswalk, by = c("type", "routine_name", "parameter"))
  input_vars <- parameters[parameters$parameter_label == "Input Variable",]
  input_vars <- input_vars[which(input_vars$routine_name == routine_name),] # primary key
  input_vars <- input_vars[which(input_vars$type == as.integer(type)),]
  variable <- ''
  
  for (i in 1:nrow(input_vars)) {
    if (nrow(input_vars) > 1 && i != nrow(input_vars)){
      variable <- paste0(variable, paste(input[[input_vars$html_id[i]]], collapse = ", "), ", ")
    } else {
      variable <- paste0(variable, paste(input[[input_vars$html_id[i]]], collapse = ", "))
    }
  }
  analysis_store[[type]][[new_index]] <<- list(
    "param_list" = param_list,
    "output" = most_recent_output_table,
    "time" = Sys.time(),
    "type" = type,
    "title" = paste0(types[types$type == type, "type_label"], " (", variable, ")"),
    "export" = TRUE,
    "routine" = routine_name,
    "footer_value" = footer_value 
  )
  df <- get_report()
  output$output_report_df <- DT::renderDataTable({render_data_report(df)})
})

observeEvent(input$remove_from_report, {
  report_rv$report_remove_button <- FALSE
  report_rv$report_add_button <- TRUE
  # types  comes from a CSV currently and won't work at the moment
  type <- types$type[which(types$type_label == routine_label)]
  for (j in 1:length(analysis_store[[type]])) {
    if (length(analysis_store[[type]][[j]]) > 0) {
      if (identical(analysis_store[[type]][[j]][["param_list"]], param_list) == TRUE) {
        analysis_store[[type]][[j]] <<- NULL
        break
      }
    }
  }
  df <- get_report()
  output$output_report_df <- DT::renderDataTable({render_data_report(df)})
})

```

Welcome
=====================================

Column
-------------------------------------

### {class="welcome-div"}

```{r welcome_page_load, results="asis"}

weclcome_md_file <- system.file(package = "idcnrba", "resources/App-Guide-for-Welcome-Page.md")
welcome_md <- readLines(weclcome_md_file) %>% paste(collapse = "\n") 
welcome_html <- markdown::renderMarkdown(text = welcome_md)
cat(welcome_html)

```


Setup
=====================================

Column
-------------------------------------
   
### **Step 1:  Import Data** {.import-data}

```{r}

fileInput(
  inputId = "input_file",
  label = "Choose File",
  multiple = TRUE,
  accept = c(".csv",".xlsx",".sas7bdat",".sav")
)

DT::DTOutput("output_files_df")

global_values$file_metadata <- data.frame(
  "Filename" = character(),
  "Rows" = character(),
  "Columns" = character(),
  "Column Names" = character(),
  check.names = FALSE
)

global_values$repaired_names <- list()

observeEvent(input$input_file, {
  
  for(i in 1:nrow(input$input_file)) {
    base_filename <- basename(input$input_file[i, "name"])
    full_filename <- input$input_file[i, "datapath"]
    if(grepl("\\.csv$", base_filename)) {
      new_data <- readr::read_csv(full_filename, name_repair = "minimal")
    } else if(grepl("\\.xlsx$", base_filename)) {
      new_data <- openxlsx::read.xlsx(full_filename, check.names = FALSE)
    } else if(grepl("\\.sas7bdat$", base_filename)) {
      new_data <- haven::read_sas(full_filename, .name_repair = "minimal")
    } else if(grepl("\\.sav$", base_filename)) {
      new_data <- haven::read_sav(full_filename, .name_repair = "minimal")
    }
    column_names <- names(new_data)
    column_names_repaired <- make.names(column_names)
    for(column_idx in 1:length(column_names)) {
      column_name <- column_names[column_idx]
      r_allowed_name <- column_names_repaired[column_idx]
      if(column_name != r_allowed_name) {
        global_values$repaired_names[[base_filename]][[r_allowed_name]]$repaired_from = column_name
        global_values$repaired_names[[base_filename]][[r_allowed_name]]$repaired_to = r_allowed_name
        names(new_data)[names(new_data) == column_name] <- r_allowed_name
      }
    }
    
    global_values[[base_filename]] <- new_data
    
	  global_values$file_metadata <- rbind(
	    global_values$file_metadata, 
	    data.frame(
  	    "Filename" = base_filename,
  	    "Rows" = nrow(new_data),
  	    "Columns" = ncol(new_data),
  	    "Column Names" = paste(names(new_data), collapse = ", "),
  	    check.names = FALSE
	    )
	  )
  }
  
  output$output_files_df <- DT::renderDT({
    DT::datatable(
    	data = global_values$file_metadata,
    	class = "compact cell-border hover",
    	rownames = F,
    	escape = FALSE,
    	selection = list(mode = "single", selected = nrow(global_values$file_metadata)),
    	options = list(
    		dom = "",
    		columnDefs = list(list(className = 'dt-left', targets = '_all'))
    	)
    )
  })
}, ignoreInit = TRUE)


```

### Data Preview {.display-data}

```{r}

DT::DTOutput("output_file_display")
#click_input <- reactive({list(input$output_files_df_cell_clicked, input$input_file)})
observeEvent({input$output_files_df_cell_clicked; input$input_file}, {
  
  if(length(input$output_files_df_cell_clicked) == 0){
    if(nrow(global_values$file_metadata) <= 0){
      return(NULL)
    }
    clicked_row <- nrow(global_values$file_metadata)
  } else {
    clicked_row <- input$output_files_df_cell_clicked$row
  }
  file_name <- global_values$file_metadata$Filename[clicked_row]
  global_values$selected_data <- global_values[[file_name]]
  output$output_file_display <- DT::renderDT({
    DT::datatable(
    	data = global_values$selected_data,
    	class = "compact cell-border",
    	selection = "none",
    	rownames = FALSE,
    	escape = TRUE,
    	style = "default",
    	options = list(
    		dom = "t",
    		pagingType = "simple",
    		headerCallback = htmlwidgets::JS(
      		"function(thead, data, start, end, display) {
          $('.dataTables_scrollBody').each(function() {
          $(this).css('max-height',''); }); }")
    	)
    )
  })
}, ignoreInit = TRUE)

```


Column
-------------------------------------


### **Step 2: Identify Data Collection Method** {.identify-data-collection-method}
    
```{r}
# Using Shinyjs to enable/disable for fields
useShinyjs(rmd = T)

disabled(radioButtons(
  inputId = "data_collection_method",
  label = "Select the option which best describes the way in which the data were collected:",
  choices = c("Attempted Census", "Survey Sample"),
  inline = T,
  width = "95%"
))

hr()# margin-left: 1in; margin-right: 1in;")

disabled(selectizeInput(
  inputId = "response_eligibility_variable",
  label = "Select the variable in your dataset that indicates each individual's eligibility/response status:",
  choices = NULL,
  multiple = FALSE,
  selected = "",
  width = "95%"
))

div(id = "options-label-1",
h5("For each category of response and eligibility status, select the appropriate value. These fields cannot be blank.", style = 
                    "font-family: 'Calibri', sans-serif;"))

fluidRow(
  column(width = 6,
    disabled(selectizeInput(
      inputId = "eligible_respondents",
      label = "Eligible Respondents",
      choices = NULL
    )),
    disabled(selectizeInput(
      inputId = "eligible_nonrespondents",
      label = "Eligible Nonrespondents",
      choices = NULL
    ))
  ),
  column(width = 6,
    disabled(selectizeInput(
      inputId = "known_ineligible",
      label = "Cases known to be ineligible",
      choices = NULL
    )),
    disabled(selectizeInput(
      inputId = "unknown_ineligible",
      label = "Cases whose eligibility status is unknown",
      choices = NULL
    ))        
  )
)

fluidRow(
  column(width = 12,
    div(id = "group_nonrespondents_div",
      disabled(radioButtons(
        input = "group_nonrespondents",
        label = "Should cases with unknown eligibility be grouped with nonrespondents for all analysis types other than response rates?",
        choices = c("Yes", "No"),
        selected = "No",
        width = "95%",
        inline = TRUE
      ))
    )
  )
)

hr()

disabled(selectizeInput(
    inputId = "population_size_variables",
    label = "Select the variables in your dataset, if any, giving the population size. Use one variable for each stage of sampling.",
    multiple = TRUE,
    choices = NULL,
    width = "95%"
))

hidden(fluidRow(
  column(width = 6,
    disabled(radioButtons(
      input = "replicate_weights",
      label = "Does the data include replicate weights?",
      choices = c("Yes", "No"),
      selected = "No",
      width = "95%",
      inline = TRUE
    ))
  ),
  column(width = 6,
    hidden(checkboxInput(
      inputId = 'combined_weights',
      label = "Do the replicate weights already include sampling weights?",
      value = TRUE,
      width = "95%"
    ))
  ) 
))

hidden(selectizeInput(
  inputId = "replicate_weight_variables",
  label = "Select the data columns containing replicate weights",
  multiple = TRUE,
  choices = NULL,
  width = "95%"
))


fluidRow(
  column(width = 6,
    hidden(selectInput(
      inputId = "replicate_weight_method",
      label = "Please select the replication method used to create these weights",
      choices = c("BRR", "Fay", "JK1","JKn","bootstrap",
       "ACS","successive-difference","JK2","other"),
      width = "95%"
    ))
  ),
  column(width = 6,
    hidden(textInput(
      inputId = "rho",
      label = "Rho shrinkage factor",
      value = "",
      width = "95%"
    ))
  )
)

fluidRow(
  column(width = 6,
    hidden(textInput(
      inputId = 'scales',
      label = "scales",
      value = "",
      width = "95%"
    ))
  ),
  column(width = 6,
    hidden(textInput(
      inputId = 'rscales',
      label = "rscales",
      value = "",
      width = "95%"
    ))
  ) 
)

div(
  id = "strata_cluster_pop_div",
  hr(),
  disabled(selectizeInput(
    inputId = "sampling_weight_variable",
    label = "Select the variable in your dataset, if any, that indicates the sampling weight for each case.",
    choices = NULL,
    multiple = FALSE,
    width = "95%"
  )),
  disabled(selectizeInput(
    inputId = "strata_variables",
    label = "Select the variables in your dataset, if any, that indicate the stratum to which each case belongs.",
    multiple = TRUE,
    choices = NULL,
    width = "95%"
  )),
  div(id = "cluster_label", 
  h5("Select the variables in your dataset, if any, representing the clusters to which each case belongs."
  , style = "font-family: 'Calibri', sans-serif;")),
  fluidRow(
    column(width = 6,
      disabled(selectizeInput(
        inputId = "psu_cluster_variables",
        label = "First Stage Cluster (PSU)",
        multiple = TRUE,
        choices = NULL
      ))
    ),
    column(width = 6,
      disabled(selectizeInput(
        inputId = "ssu_cluster_variables",
        label = "Second Stage Cluster (SSU)",
        multiple = TRUE,
        choices = NULL
      ))
    )
  )
)

actionButton("proceed_to_analysis",
  label = "Proceed to Analysis",
  class="btn btn-default btn-sm"
)

observeEvent(input$proceed_to_analysis, {
  proceed_errors <<- ""
  # counts errors and determines whether or not error checks renders modal
  error_counter <<- 0
  for (i in 1:nrow(setup_module_checks[setup_module_checks$is_enabled == 1,])) {
    result <- regmatches(setup_module_checks$error_message[i], gregexpr("\\[\\$(.*?)\\]", setup_module_checks$error_message[i]))
    result <- unique(result[[1]])
    # setup check 13 doesn't have a variable name and I'm out of ideas (see error function in tryCatch for more details)
    # result <- ifelse(setup_module_checks$query_id[i] != 13, gsub("\\[\\$|\\]", "", result), "ssu_cluster_variables")
    if (setup_module_checks$query_id[i] != 13){
      result <- gsub("\\[\\$|\\]", "", result)
    } else{
      result <- "ssu_cluster_variables"
    }
    tryCatch({
      # if the query returns true, then there is an error on the setup page
      if (eval(parse(text = setup_module_checks$setup_query_code[i]))) {
        # if result isn't an empty string and you can evaluate input$[result] replace the error message variable result was pulled from with the input value. This is here because some error messages (checks 1-6) don't have variables to pull from
        if (!any(is.na(result)) & length(result) > 0){
          for (j in 1:length(result)) {
            setup_module_checks$error_message[i] <<- gsub(paste0("\\[\\$",result[j],"\\]"), paste(eval(parse(text = paste0("input$",result[j]))), collapse = ", "), setup_module_checks$error_message[i])
          }
        }
        proceed_errors <<- paste0(proceed_errors, "- ", setup_module_checks$error_message[i], "<br><br>")
        error_counter <<- error_counter + 1
      }
    }, error = function(err){
      if (length(result) > 0) {
        for (j in 1:length(result)) {
          setup_module_checks$error_message[i] <<- gsub(paste0("\\[\\$",result[j],"\\]"), "NULL", setup_module_checks$error_message[i])
        }
      }
      # check 13 is looking to see if psu_cluster_variables is set or not. Since the input isn't set, the query returns an error. Since we don't want to write error messages for every variable that isn't set, I've hard coded this until a better solution is found
      proceed_errors <<- ifelse((setup_module_checks$query_id[i] == 13 & isTruthy(input$ssu_cluster_variables)), paste0(proceed_errors, "- ", setup_module_checks$error_message[i], "<br><br>"), proceed_errors)
      error_counter <<- error_counter + 1
    })
  }
  cat(paste0("\nerrors: ", proceed_errors))
  if (error_counter > 0 & proceed_errors != "") {
    output$setup_errors <- showModal(renderUI(modalDialog(
      HTML(paste0("There are one or more errors in the options selected in the Setup module. <br><br>",proceed_errors)))
  ))
    shinyjs::runjs(paste0('window.location.href = "#section-setup";'))
  } else {
    shinyjs::runjs(paste0('window.location.href = "#section-analysis";'))
  }
}, ignoreInit = TRUE)

# Update inputs that use variable names based on selected data file
#click_input <- reactive({list(input$output_files_df_cell_clicked, input$input_file)})
observeEvent({input$output_files_df_cell_clicked; input$input_file}, {
  
  enable("data_collection_method")
  enable("response_eligibility_variable")
  enable("replicate_weights")
  enable("strata_variables")
  enable("psu_cluster_variables")
  enable("ssu_cluster_variables")
  enable("sampling_weight_variable")
  enable("population_size_variables")

  variable_names <- colnames(global_values$selected_data)
  
  updateSelectizeInput(inputId = "replicate_weight_variables", choices = variable_names)
  updateSelectizeInput(inputId = "response_eligibility_variable", choices = variable_names, selected = "")
  updateSelectizeInput(
    inputId = "strata_variables", 
    choices = variable_names,
    options = list(placeholder = '[No Strata Variables]')
  )
  updateSelectizeInput(
    inputId = "psu_cluster_variables",
    choices = variable_names,
    options = list(placeholder = '[No Cluster Variables]'),
  )
  updateSelectizeInput(
    inputId = "ssu_cluster_variables", 
    choices = variable_names,
    options = list(placeholder = '[No Cluster Variables]')
  )
  updateSelectInput(
    inputId = "sampling_weight_variable", 
    choices = c("[No Weights]", variable_names), 
    selected = "[No Weights]"
  )
  updateSelectInput(
    inputId = "population_size_variables", 
    choices = c("[No Population Size Variables]" = "", variable_names)
  )

}, ignoreInit = TRUE)

# Update inputs that use variables values based on selected response eligibility variable
observeEvent(input$response_eligibility_variable, {
  
  if (length(input$response_eligibility_variable) > 0) {
    enable("eligible_respondents")
    enable("eligible_nonrespondents")
    enable("known_ineligible")
    enable("unknown_ineligible")
  }
  
  variable_values <- unique(global_values$selected_data[[input$response_eligibility_variable]])
  cat(length(variable_values))
  # Note each DOES NOT APPLY value has to be a unique value for response rate calculations
  updateSelectizeInput(
    inputId = "eligible_respondents",
    options = list(onInitialize = I('function() { this.setValue(""); }')),
    choices = c(variable_values, "[DOES NOT APPLY]" = "does_not_apply_1"))
  updateSelectizeInput(
    inputId = "eligible_nonrespondents",
    options = list(onInitialize = I('function() { this.setValue(""); }')),
    choices = c(variable_values, "[DOES NOT APPLY]" = "does_not_apply_2"))
  updateSelectizeInput(
    inputId = "known_ineligible",
    options = list(onInitialize = I('function() { this.setValue(""); }')),
    choices = c(variable_values, "[DOES NOT APPLY]" = "does_not_apply_3"))
  updateSelectizeInput(
    inputId = "unknown_ineligible",
    options = list(onInitialize = I('function() { this.setValue(""); }')),
    choices = c(variable_values, "[DOES NOT APPLY]" = "does_not_apply_4"))
  
  if (input$data_collection_method == "Attempted Census") {
    hide("strata_cluster_pop_div")
  } else {
    show("strata_cluster_pop_div")
  }
  
}, ignoreInit = TRUE)

observeEvent(input$unknown_ineligible, {
  global_values$selected_data[, "analysis_response_eligibility_variable"] <- global_values$selected_data[, input$response_eligibility_variable]
  if(input$unknown_ineligible != "does_not_apply_4") {
    enable("group_nonrespondents")
    show("group_nonrespondents_div")
    # set default variables
    global_values$analysis_ue_category <- input$unknown_ineligible
  } else {
    enable("group_nonrespondents")
    hide("group_nonrespondents_div")
  }
}, ignoreInit = TRUE)

observeEvent(input$group_nonrespondents, {
  if(input$group_nonrespondents == "Yes") {
    global_values$analysis_ue_category <- "does_not_apply_4"
    global_values$selected_data[, "analysis_response_eligibility_variable"] <- global_values$selected_data[, input$response_eligibility_variable]
    global_values$selected_data[which(global_values$selected_data[, "analysis_response_eligibility_variable"] == input$unknown_ineligible), "analysis_response_eligibility_variable"] <- input$eligible_nonrespondents 
  } else {
    global_values$analysis_ue_category <- input$unknown_ineligible
    global_values$selected_data[, "analysis_response_eligibility_variable"] <- global_values$selected_data[, input$response_eligibility_variable]
  }
}, ignoreInit = TRUE)


observeEvent(input$replicate_weights, {
  if (input$replicate_weights == "Yes") {
    show("combined_weights")
    show("replicate_weight_method")
    show("scales")
    show("rscales")
    show("replicate_weight_variables")
    show("rho")
    if (input$replicate_weight_method == "BRR") {
      enable("rho")
    } else {
      disable("rho")
    }
    hide("strata_cluster_pop_div")
  } else {
    hide("combined_weights")
    hide("replicate_weight_variables")
    hide("replicate_weight_method")
    hide("scales")
    hide("rscales")   
    hide("rho")
    if(input$data_collection_method != "Attempted Census"){
      show("strata_cluster_pop_div")
    }
  }
}, ignoreInit = TRUE)

observeEvent(input$replicate_weight_method, {
  if (input$replicate_weight_method == "BRR") {
    enable("rho")
  } else {
    disable("rho")
  }
})

observeEvent(input$data_collection_method, {
  if (input$data_collection_method == "Attempted Census") {
    hide("strata_cluster_pop_div")
  } else {
    show("strata_cluster_pop_div")
  }
})

#nonrespondent_census_list <- reactive({list(input$data_collection_method, input$eligible_nonrespondents, input$unknown_ineligible, input$analysis_adjust_weights)})
observeEvent({input$data_collection_method; input$eligible_nonrespondents; input$unknown_ineligible}, {
  if (input$data_collection_method == "Attempted Census") {
    if (input$eligible_nonrespondents != "does_not_apply_2") {
      global_values$is_census_data_with_nonrespondents <- TRUE
      hide("population_size_variables")
    } else if (input$unknown_ineligible != "does_not_apply_4") {
      global_values$is_census_data_with_nonrespondents <- TRUE
      hide("population_size_variables")
    } else {
      global_values$is_census_data_with_nonrespondents <- FALSE
      show("population_size_variables")
    }
  } else {
    global_values$is_census_data_with_nonrespondents <- FALSE
    show("population_size_variables")
  }
}, ignoreInit = TRUE)

# set respondents_only value if both eligible nonrespondent and
# unknown ineligible are both [Does Not Apply]
observeEvent({input$eligible_nonrespondents; input$unknown_ineligible}, {
  if (input$eligible_nonrespondents == "does_not_apply_2" & input$unknown_ineligible == "does_not_apply_4") {
    global_values$respondents_only <- TRUE
  } else {
    global_values$respondents_only <- FALSE
  }
})

```


Analysis {.analysis-tab}
=====================================

Column
-------------------------------------

### Select one or more analyses to run based on the question(s) you want to answer. {.select-analysis-type}

```{r}

h3(strong("What are our response rates and do they differ across subgroups?"))

analysisButton(
  inputId = "analysis_response_rates", 
  label = types$type_label[1],
  description = types$type_description[1],
  info_link = system.file("shiny/analysis-guides/response-rates-analysis_shiny.html", package = 'nrba')
)

analysisButton(
  inputId = "analysis_subpop_differ",
  label = types$type_label[2],
  description = types$type_description[2]
)

analysisButton(
  inputId = "analysis_predict_response", 
  label = types$type_label[3],
  description = types$type_description[3]
)

h3(strong("Are some subgroups in the population overrepresented or underrepresented in our respondent data?"))
analysisButton(
  inputId = "analysis_compare_sample", 
  label = types$type_label[4],
  description = types$type_description[4]
)
analysisButton(
  inputId = "analysis_compare_external", 
  label = types$type_label[5],
  description = types$type_description[5]
)

h3(strong("How do survey outcomes differ across subgroups?"))
analysisButton(
  inputId = "analysis_across_subgroups", 
  label = types$type_label[6],
  description = types$type_description[6]
)
analysisButton(
  inputId = "analysis_aux_predictive", 
  label = types$type_label[7],
  description = types$type_description[7]
)
analysisButton(
  inputId = "analysis_cumulative_estimates", 
  label = types$type_label[8],
  description = types$type_description[8]
)

h3(strong("Can statistical adjustments reduce nonresponse bias?"))
analysisButton(
  inputId = "analysis_adjust_weights",
  label = types$type_label[9],
  description = types$type_description[9]
)

```

Column
-------------------------------------

### Specify Analysis {.specify-analysis}

```{r Calculate response rates by subgroup}

observeEvent(input$analysis_response_rates, {
  global_values$last_analysis_clicked <- "analysis_response_rates"
}, ignoreInit = TRUE)

observeEvent(input$analysis_response_rates, {
  
  output$analysis_config <- renderUI({
    
    div(
      fluidRow(
        column(width = 6,
          selectizeInput(
            inputId = "analysis_response_rates_group",
            label = "Choose grouping variable(s):",
            multiple = TRUE,
            choices = colnames(global_values$selected_data),
            options = list(placeholder = '[None]')
          )
        ),
        column(width = 6,
          selectizeInput(
            inputId = "rr_formula",
            label = "Choose the response rate formula:",
            selected = "RR3",
            multiple = FALSE,
            choices = c("RR1" = "RR1", "RR3 (recommended)" = "RR3", "RR5" = "RR5")
          )
        )
      ),
      fluidRow(
        column(width = 6,
          selectizeInput(
            inputId = "elig_method",
            label = "Choose method for estimating eligibility rate for unknown eligibility cases:",
            multiple = FALSE,
            choices = c("CASRO overall","CASRO subgroup (recommended)","specified"),
            selected = "CASRO subgroup (recommended)"
          )            
        ),
        column(width = 6,
          textInput(
            inputId = "e_specified",
            label = "Estimated eligibility rate:"
          )
        )
      ),
      actionButton("analysis_response_rates_submit", "Submit"),
      hr()
    )
  })
  
  
  
})

observeEvent(input$rr_formula , {
  if (input$rr_formula == "RR3") {
    enable("elig_method")
  } else {
    disable("elig_method")
    updateTextInput(inputId = "e_specified", value = "")
    disable("e_specified")    
  }
})

observeEvent(input$elig_method , {
  if (input$elig_method == "specified") {
    enable("e_specified")
  } else {
    updateTextInput(inputId = "e_specified", value = "")
    disable("e_specified")
  }
})

observeEvent(input$analysis_response_rates_submit, {
  routine_name <<- "calculate_response_rates"
  routine_label <<- routines[which(routines$routine_name == routine_name), "routine_label"]
  withProgress(message = "Running Analysis...", {
    n = 1/3
    output_table <- tryCatch({
      
      if (global_values$respondents_only & is.null(input$analysis_response_rates_group)) {
        stop("Response rates by subgroup cannot be calculated since the dataset does not contain any eligible nonrespondents or cases with unknown eligibility.")
      }
      
      if (global_values$respondents_only & input$data_collection_method == "Survey Sample") {
        stop("Response rates cannot be calculated for a survey sample when the dataset does not contain any eligible nonrespondents or cases with unknown eligibility.")
      }
      
      if (global_values$respondents_only & input$data_collection_method == "Attempted Census" & is.null(input$population_size_variables)) {
        stop("Can only calculate an overall response rate for an attempted census if the data contain eligible respondents or cases with unknown eligibility, or if a population size was specified during setup.")
      }
      
      if (input$sampling_weight_variable == "[No Weights]") {
        sampling_weight_variable_input <- NULL 
      } else {
        sampling_weight_variable_input <- input$sampling_weight_variable
      }
      incProgress(n)
  
      if (input$elig_method == "CASRO subgroup (recommended)") {
        elig_method_input <- "CASRO-subgroup" 
      } else if (input$elig_method == "CASRO overall") {
        elig_method_input <- "CASRO-overall"
      } else {
        elig_method_input <- input$elig_method
      }
      
      data <-group_by(global_values$selected_data, across(input$analysis_response_rates_group))
      incProgress(n)
      
      param_list <<- list(
        "data" = data,
        "status" = input$response_eligibility_variable,
        "status_codes" = c(
            "ER" = input$eligible_respondents,
            "EN" = input$eligible_nonrespondents,
            "IE" = input$known_ineligible,
            "UE" = input$unknown_ineligible
          ),
        "weights" = sampling_weight_variable_input,
        "rr_formula" = input$rr_formula,
        "elig_method" = elig_method_input,
        "e" = as_numeric_input(input$e_specified)
      )
      footer_value <<- NULL
      do.call(calculate_response_rates, param_list)
    }, error = function(e) {
      return(e)
    })
    incProgress(n)
    
  })
  output$analysis_output <- render_analysis_output(output_table)
})
```


```{r Test whether subgroups differ in likelihood of responding}
observeEvent(input$analysis_subpop_differ, {
  global_values$last_analysis_clicked <- "analysis_subpop_differ"
}, ignoreInit = TRUE)

observeEvent(input$analysis_subpop_differ, {
  output$analysis_config <- renderUI({
    tagList(
      selectizeInput(
        inputId = "chisq_aux_variables",
        label = "Choose grouping variable(s):",
        multiple = TRUE,
        choices = colnames(global_values$selected_data),
        options = list(placeholder = '[None]')
      ),
      actionButton("analysis_subpop_differ_submit", "Submit")
    )
  })
})


observeEvent(input$analysis_subpop_differ_submit, {
  routine_name <<- "chisq_test_ind_response"
  routine_label <<- routines[which(routines$routine_name == routine_name), "routine_label"]
  withProgress(message = "Running Analysis...", {
    n = 1/3
    output_table <- tryCatch({
   
      if (global_values$respondents_only){
        stop("The dataset does not contain any eligible nonrespondents or cases with unknown eligibility.")
      }
      
      survey_design <- get_survey_design_object(
        data = global_values$selected_data, 
        input = input
      )
      incProgress(n)
      
      status_codes <- c(
        "ER" = input$eligible_respondents,
        "EN" = input$eligible_nonrespondents,
        "IE" = input$known_ineligible,
        "UE" = global_values$analysis_ue_category
      )
      incProgress(n)
      
      
      param_list <<- list(
        "survey_design" = survey_design, 
        "status" = "analysis_response_eligibility_variable", 
        "status_codes" = status_codes, 
        "aux_vars" = input$chisq_aux_variables)
      
      footer_value <<- NULL
      do.call(chisq_test_ind_response, param_list)
      
    }, error = function(e) {
      return(e)
    })
    incProgress(n)
  })
  output$analysis_output <- render_analysis_output(output_table)
})

```


```{r Compare subgroup percentages in respondent data to external data}

observeEvent(input$analysis_compare_external, {
  global_values$last_analysis_clicked <- "analysis_compare_external"
}, ignoreInit = TRUE)

observeEvent(input$analysis_compare_external, {
  output$analysis_config <- renderUI({
    tagList(
      selectizeInput(
        inputId = "t3_y_var",
        label = "Choose a grouping variable:",
        multiple = FALSE,
        choices = colnames(global_values$selected_data),
        width = "95%",
        options = list(
          placeholder = '[None]',
          onInitialize = I('function() { this.setValue(""); }'))
      ),
      fluidRow(
        column(width = 7,
          radioButtons(
            input = "t3_y_var_categorical",
            label = "Is the grouping variable categorical?",
            choices = c("Yes", "No"),
            selected = "No",
            width = "95%",
            inline = TRUE
          )
        )),
      uiOutput("external_benchmark_input"),
      radioButtons(
            inputId = "t3_drop_missing_y_var",
            label = "Drop cases with missing values for the grouping variable?",
            choices = c("Yes", "No"),
            selected = "No",
            width = "95%",
            inline = TRUE
      ),
      fluidRow(
        column(width = 5,
          radioButtons(
            input = "t3_t_or_chisq_test",
            label = "Choose the test:",
            choices = c("t test", "Chi-squared test"),
            selected = "t test",
            width = "95%",
            inline = TRUE
          )
        )),
      numericInput(
        inputId = "t3_null_difference",
        label = "Enter the value of the hypothesized difference between the estimate and the benchmark:",
        value = 0,
        width = "95%"
      ),
      selectizeInput(
        inputId = "t3_alternative",
        label = "Choose alternative hypothesis for this test:",
        multiple = FALSE,
        choices = c(
          "Actual difference is unequal to hypothesized difference." = "unequal", 
          "Actual difference is less than hypothesized difference." = "less", 
          "Actual difference is greater than hypothesized difference." = "greater"
        ),
        width = "95%"
      ),
      hide(textInput(
        inputId = "t3_degrees_of_freedom",
        label = "Specify degrees of freedom:",
        value = "",
        width = "95%"
      )),
      actionButton("analysis_compare_external_submit", "Submit")
    )
  })
  
})

observeEvent(input$t3_y_var_categorical, {
  if (input$t3_y_var_categorical == "Yes") {
    enable("t3_t_or_chisq_test")
  } else {
    updateRadioButtons(inputId = "t3_t_or_chisq_test", selected = "t test")
    disable("t3_t_or_chisq_test")
  }
})

observeEvent(input$t3_t_or_chisq_test, {
  if (input$t3_t_or_chisq_test == "Chi-squared test") {
    hide("t3_null_difference")
    hide("t3_alternative")
  } else {
    show("t3_null_difference")
    show("t3_alternative")
  }
})

observeEvent({input$t3_y_var; input$t3_y_var_categorical}, {
  
  if (input$t3_y_var_categorical == "Yes" & nchar(input$t3_y_var) > 0) {
    
    y_var_values <- sort(unique(global_values$selected_data[[input$t3_y_var]]))
  
    external_benchmark_table_edited <<- tibble(
        "{input$t3_y_var}" := y_var_values[!is.na(y_var_values)]
      ) %>%
      mutate(Percentages = NA_real_) %>%
      mutate(`Standard Error` = NA_real_)
    
    output$external_benchmark_table <- DT::renderDataTable({
      DT::datatable(
        data = external_benchmark_table_edited,
        rownames = FALSE,
        extensions = 'KeyTable',
        caption = tags$caption(
          'Enter values from external data (double-click cells in yellow to edit):',
          style = 'caption-side: top;text-align:center;color:black;'
        ),
        class = "compact cell-border",
        selection = "none",
        editable = list(
          target = 'cell',
          enable = list(columns = 1:2),
          disable = list(columns = 0)
        ),
        options = list(
          dom = "t",
          ordering = FALSE,
          keys = TRUE,
          autoWidth = TRUE,
          columnDefs = list(
            list(width = '200px', targets = 0),
            list(width = '20px', targets = 1:2)
          )
        )
      ) %>%
      DT::formatStyle(
        columns = 1,
        fontWeight = "bold"
      ) %>%
      DT::formatStyle(
        columns = 2:3,
        backgroundColor = "lightYellow",
        fontStyle = "italic",
        fontSize = "18px",
        cursor = "cell"
      )
    })
    
    output$external_benchmark_input <- renderUI({
      fluidRow(column(align = "center", width = 12, DT::DTOutput("external_benchmark_table")))
    })
    
  } else {
    
    output$external_benchmark_input <- renderUI({
      numericInput(
        inputId = "external_benchmark_value",
        label = "Enter value from external data:",
        value = 0
      )
    })
    
  }

})


# Listen to whether table cells have been updated and update accordingly
observeEvent(input$external_benchmark_table_cell_edit, {
  external_benchmark_table_edited[
    input$external_benchmark_table_cell_edit$row,
    input$external_benchmark_table_cell_edit$col + 1
  ] <<- as.double(input$external_benchmark_table_cell_edit$value)
  
  
})


observeEvent(input$analysis_compare_external_submit, {
  
  withProgress(message = "Running Analysis...", {
    n <- 1/4
    output_table <- tryCatch({
      
      if (global_values$respondents_only){
        stop("The dataset does not contain any eligible nonrespondents or cases with unknown eligibility.")
      }
      
      if (input$t3_t_or_chisq_test == "t test") {
        routine_name <<- "t_test_vs_external_estimate"
        routine_label <<- routines[which(routines$routine_name == routine_name), "routine_label"]
      } else {
        routine_name <<- "chisq_test_vs_external_estimate"
        routine_label <<- routines[which(routines$routine_name == routine_name), "routine_label"]
      }

      if (exists("external_benchmark_table_edited")) {
        if (any(external_benchmark_table_edited$Percentages < 0)) {
          stop("Percentages for external data cannot be below 0")
        }
        # checks if values are entered as 0.5 or 50%, assumes no one would type 1.3 meaning 130%
        if (all(external_benchmark_table_edited$Percentages <= 1)) {
          if (sum(external_benchmark_table_edited$Percentages) <= 0.99 |
              sum(external_benchmark_table_edited$Percentages) >= 1.01) {
            stop("Percentages for external data must add up to 100%")
          }
        } else {
          if (sum(external_benchmark_table_edited$Percentages) <= 99 |
              sum(external_benchmark_table_edited$Percentages) >= 101) {
            stop("Percentages for external data must add up to 100%")
          }
        }
      }
      survey_design <- get_survey_design_object(
        data = global_values$selected_data, 
        input = input
      )
  
      resp_design <- subset(
        x = survey_design, 
        get(input$response_eligibility_variable) == input$eligible_respondents
      )
      incProgress(n)
      
      if (input$t3_y_var_categorical == "Yes") {
        # Transform edited table into named vector
        external_estimates <- external_benchmark_table_edited %>%
          tibble::column_to_rownames(input$t3_y_var) %>%
          select(Percentages) %>%
          t() %>%
          drop()
        
        external_standard_errors <- external_benchmark_table_edited %>%
          tibble::column_to_rownames(input$t3_y_var) %>%
          select(`Standard Error`) %>%
          t() %>%
          drop()
        
        if (anyNA(external_standard_errors)) external_standard_errors <- NULL
        
      } else {
        external_estimates <- input$external_benchmark_value
        external_standard_errors <- NULL
      }
      incProgress(n)
  
      degrees_of_freedom <- ifelse(
        is.null(as_numeric_input(input$t3_degrees_of_freedom)),
        survey::degf(resp_design) - 1,
        as_numeric_input(input$t3_degrees_of_freedom)
      )
      incProgress(n)
      
      if (input$t3_t_or_chisq_test == "t test") {
        param_list <<- list(
        "survey_design" = resp_design, 
        "y_var" = input$t3_y_var,
        "ext_ests" = external_estimates,
        "ext_std_errors" = external_standard_errors,
        "na.rm" = switch(input$t3_drop_missing_y_var, "Yes" = TRUE, "No" = FALSE),
        "null_difference" = input$t3_null_difference,
        "alternative" = input$t3_alternative,
        "degrees_of_freedom" = degrees_of_freedom)
        footer_value <<- NULL
        do.call(t_test_vs_external_estimate, param_list)
      } else {
        param_list <<- list(
          "survey_design" = resp_design,
          "y_var" = input$t3_y_var,
          "ext_ests" = external_estimates,
          "na.rm" = switch(input$t3_drop_missing_y_var, "Yes" = TRUE, "No" = FALSE)
        )
        footer_value <<- NULL
        do.call(chisq_test_vs_external_estimate, param_list)
      }
    }, error = function(e) {
      return(e)
    })
    incProgress(n)
    
  })
  output$analysis_output <- render_analysis_output(output_table)
  
})

```

```{r Compare subgroup percentages in respondent data to data from respondents and nonrespondents}
observeEvent(input$analysis_compare_sample, {
  global_values$last_analysis_clicked <- "analysis_compare_sample"
}, ignoreInit = TRUE)

observeEvent(input$analysis_compare_sample, {
  output$analysis_config <- renderUI({
    tagList(
      selectizeInput(
        inputId = "t4_y_var",
        label = "Choose one or more grouping variable(s):",
        multiple = TRUE,
        choices = colnames(global_values$selected_data),
        width = "95%",
        options = list(
          placeholder = '[None]',
          onInitialize = I('function() { this.setValue(""); }'))
      ),
      fluidRow(
        column(width = 10,
               hide(
                 radioButtons(
                   input = "t4_t_full_or_elig",
                   label = "Choose the comparison:",
                   choices = c("Respondents vs. Respondents and Nonrespondents", "Respondents vs. All sampled cases (regardless of response or eligibility status)"),
                   selected = "Respondents vs. Respondents and Nonrespondents",
                   width = "95%",
                   inline = FALSE
                 )
               )
        )
      ),
      numericInput(
        inputId = "t4_null_difference",
        label = "Enter the value of the hypothesized difference between the estimate and the full sample:",
        value = 0,
        width = "95%"
      ),
      selectizeInput(
        inputId = "t4_alternative",
        label = "Choose alternative hypothesis for this test:",
        multiple = FALSE,
        choices = c(
          "Actual difference is unequal to hypothesized difference." = "unequal", 
          "Actual difference is less than hypothesized difference." = "less", 
          "Actual difference is greater than hypothesized difference." = "greater"
        ),
        width = "95%"
      ),
      hide(textInput(
        inputId = "t4_degrees_of_freedom",
        label = "Specify degrees of freedom:",
        value = "",
        width = "95%"
      )),
      actionButton("t4_analysis_compare_sample_submit", "Submit")
    )
  })
  
})

observeEvent(input$t4_analysis_compare_sample_submit, {
  withProgress(message = "Running Analysis...", {
    n <- 1/4
    output_table <- tryCatch({
  
      survey_design <- get_survey_design_object(
        data = global_values$selected_data, 
        input = input
      )
      incProgress(amount = n)
      
      degrees_of_freedom <- ifelse(
        is.null(as_numeric_input(input$t4_degrees_of_freedom)),
        survey::degf(survey_design) - 1,
        as_numeric_input(input$t4_degrees_of_freedom)
      )
      status_codes <- c(
        "ER" = input$eligible_respondents,
        "EN" = input$eligible_nonrespondents,
        "IE" = input$known_ineligible,
        "UE" = global_values$analysis_ue_category
      )
      incProgress(amount = n)
      
      if (is.null(input$t4_t_full_or_elig)) {
        t4_comparison <- "Respondents vs. Respondents and Nonrespondents"
      } else {
        t4_comparison <- input$t4_t_full_or_elig
      }
      incProgress(amount = n)
      
      
      if (t4_comparison == "Respondents vs. All sampled cases (regardless of response or eligibility status)") {
        routine_name <<- "t_test_resp_vs_full"
        routine_label <<- routines[which(routines$routine_name == routine_name), "routine_label"]
        param_list <<- list(
        "survey_design" = survey_design,
        "y_var" = input$t4_y_var,
        "status" = "analysis_response_eligibility_variable", 
        "status_codes" = status_codes, 
        "null_difference" = input$t4_null_difference,
        "alternative" = input$t4_alternative,
        "degrees_of_freedom" = degrees_of_freedom)
        footer_value <<- NULL
        do.call(t_test_resp_vs_full, param_list)
      } else {
        routine_name <<- "t_test_resp_vs_elig"
        routine_label <<- routines[which(routines$routine_name == routine_name), "routine_label"]
        param_list <<- list(
        "survey_design" = survey_design,
        "y_var" = input$t4_y_var,
        "status" = "analysis_response_eligibility_variable", 
        "status_codes" = status_codes, 
        "null_difference" = input$t4_null_difference,
        "alternative" = input$t4_alternative,
        "degrees_of_freedom" = degrees_of_freedom)
        footer_value <<- NULL
        do.call(t_test_resp_vs_elig, param_list)
      }
    }, error = function(e) {
      return(e)
    })
    incProgress(amount = n)
  
    output$analysis_output <- render_analysis_output(output_table)
  })
})
```

```{r Compare estimates based on respondent data before and after weighting adjustments}
# Using Shinyjs to enable/disable for fields
useShinyjs(rmd = T)

observeEvent(input$analysis_adjust_weights, {
  global_values$last_analysis_clicked <- "analysis_adjust_weights"
}, ignoreInit = TRUE)

observeEvent({input$analysis_adjust_weights; global_values$is_census_data_with_nonrespondents}, {
  variable_names <- colnames(global_values$selected_data)
  # T5 Analysis Updates
  updateSelectInput(inputId = "t5_raked_replicate_weight_variables", choices = variable_names)
  updateSelectInput(inputId = "t5_raking_group_vars", choices = variable_names)
  updateSelectInput(inputId = "t5_raking_benchmark_vars", choices = variable_names)
  updateSelectInput(inputId = "t5_wt_adj_comparison_vars", choices = variable_names)
  
  global_values$survey_design <- tryCatch({
    get_survey_design_object(
      data = global_values$selected_data, 
      input = input
    )
  }, error = function(e) { return(e) })
  
  if ("svyrep.design" %in% class(global_values$survey_design)) {
    # Create rep survey design call but do not evaluate yet
    # orig_rep_design_call <- substitute(global_values$survey_design)
    output$as_rep_design_controls <- NULL
  } else if ("survey.design" %in% class(global_values$survey_design)) {
    output$as_rep_design_controls <- renderUI({
      tagList(
        {
          if (global_values$is_census_data_with_nonrespondents) {
            div(id = "t5_replicate_weight_method_div")
          } else {
            div(id = "t5_replicate_weight_method_div",
              selectInput(
                inputId = "t5_replicate_weight_method",
                label = paste(
                  "For this analysis, replicate weights will be created.", 
                  "Select a type of replicate weight:"
                ),
                choices = c("Jackknife (JKn or JK1)","Bootstrap (Recommended)"),
                selected = "Bootstrap (Recommended)",
                width = "95%"
              )
            )
          }
        },
        {
          if (global_values$is_census_data_with_nonrespondents) {
            div(id = "t5_n_replicates_div")
          } else {
            div(id = "t5_n_replicates_div",
              numericInput(
                inputId = "t5_n_replicates",
                label = "Select number of bootstrap replicates (500 or more):",
                value = pmin(500, 2 * degf(global_values$survey_design)),
                width = "95%"
              )
            )
          }
        }
      )
    })

  } else {
    output$as_rep_design_controls <- renderUI({
      tags$h4(global_values$survey_design, style = "color: darkred;")
    })
  }
  if (is.character(global_values$last_analysis_clicked)){
    if (global_values$last_analysis_clicked == "analysis_adjust_weights"){
      output$analysis_config <- renderUI({
        tagList(
          uiOutput("as_rep_design_controls"),
          hidden(checkboxInput(
            inputId = "t5_raked_reps_included",
            label = "Are there raked replicate weights already included in the data?",
            width = "95%" 
          )),
          #hr(),
          hidden(div(id = "t5_reps_exist_controls",
            selectizeInput(
              inputId = "t5_raked_replicate_weight_variables",
              label = "Select the data columns containing replicate weights",
              multiple = TRUE,
              choices = NULL,
              width = "95%"
            ),
            checkboxInput(
              inputId = 't5_raked_combined_weights',
              label = "Do the replicate weights already include sampling weights?",
              value = TRUE,
              width = "95%"
            ),
            fluidRow(
              column(width = 6,
                selectInput(
                  inputId = "t5_raked_replicate_weight_method",
                  label = "Select the replication method used to create these weights",
                  choices = c("BRR", "Fay", "JK1","JKn","bootstrap",
                   "ACS","successive-difference","JK2","other"),
                  width = "95%"
                )
              ),
              column(width = 6,
                textInput(
                  inputId = "t5_raked_rho",
                  label = "Rho shrinkage factor",
                  value = "",
                  width = "95%"
                )
              )
            ),
            fluidRow(
              column(width = 6,
                textInput(
                  inputId = 't5_raked_scales',
                  label = "scales",
                  value = "",
                  width = "95%"
                )
              ),
              column(width = 6,
                textInput(
                  inputId = 't5_raked_rscales',
                  label = "rscales",
                  value = "",
                  width = "95%"
                )
              ) 
            )
          )),
          div(id = "t5_reps_absent_controls",
            selectizeInput(
              inputId = "t5_raking_group_vars",
              label = "Choose grouping variables to use for raking",
              multiple = TRUE,
              choices = NULL,
              width = "95%",
              options = list(
                placeholder = '[None]')
            )),
          {
            if (global_values$is_census_data_with_nonrespondents){
              div(id = "t5_raking_benchmarks")
            } else {
              div(id = "t5_raking_benchmarks",
                selectizeInput(
                  inputId = "t5_raking_benchmark_vars",
                  label = "Choose corresponding variables with values of benchmarks",
                  multiple = TRUE,
                  choices = NULL,
                  width = "95%",
                  options = list(
                    placeholder = '[None]'))
              )
            }
          },
          #hr(),
          selectizeInput(
            inputId = "t5_wt_adj_comparison_vars",
            label = "Choose variables whose means should be compared before and after raking",
            multiple = TRUE,
            choices = NULL,
            width = "95%",
            options = list(
              placeholder = '[None]')
          ),
          #hr(),
          actionButton("t5_analysis_adjust_weights_submit", "Submit")
        )
      })
    }
  }
}, ignoreInit = TRUE)



observeEvent(input$t5_raked_reps_included, {
  if (input$t5_raked_reps_included) {
    show("t5_reps_exist_controls")
    hide("t5_reps_absent_controls")
  } else {
    hide("t5_reps_exist_controls")
    show("t5_reps_absent_controls")
  }
})

observeEvent(input$t5_replicate_weight_method, {
  if (input$t5_replicate_weight_method == "Bootstrap (Recommended)") {
    enable("t5_n_replicates")
  } else if (input$t5_replicate_weight_method == "Jackknife (JKn or JK1)") {
    disable("t5_n_replicates")
  }
})

observeEvent(input$t5_analysis_adjust_weights_submit, {
  routine_name <<- "t_test_of_weight_adjustment"
  routine_label <<- routines[which(routines$routine_name == routine_name), "routine_label"]
  withProgress(message = "Running Analysis...", {
    # n equals the subdivision of steps in this process used for incrementing the progress bar, here there are 5 steps so n = 1/5
    n <- 1/5
  output_table <- tryCatch({
    # Create rep survey design calls but do not evaluate yet
    if (!global_values$is_census_data_with_nonrespondents) {
      if (input$t5_replicate_weight_method == "Bootstrap (Recommended)") {
        orig_rep_design <- as.svrepdesign(
          design = global_values$survey_design, 
          type = "subbootstrap", 
          replicates = input$t5_n_replicates
        )
      } else if (input$t5_replicate_weight_method == "Jackknife (JKn or JK1)") {
        orig_rep_design <- as.svrepdesign(
          design = global_values$survey_design,
          type = "auto"
        )
      }
    } else {
      orig_rep_design <- svrep::as_random_group_jackknife_design(
        design = global_values$survey_design,
        replicates = 50,
        adj_method = "variance-stratum-psus",
        scale_method = "variance-stratum-psus"
      )
      orig_rep_design$type <- "other"
    }
    incProgress(amount = n)
    
    # Subset orig rep design to only include eligible respondents
    orig_resp_rep_design <- subset(
      x = orig_rep_design, 
      get(input$response_eligibility_variable) == input$eligible_respondents
    )
    incProgress(amount = n)
    
    if (input$t5_raked_reps_included) {
      raked_rep_design <- get_survey_design_object(
        data = global_values$selected_data,
        input = input,
        secondary_raked = TRUE
      )
      raked_resp_rep_design <- subset(
        raked_rep_design,
        get(input$response_eligibility_variable) == input$eligible_respondents
      ) 
      incProgress(amount = n)
    } else if (!global_values$is_census_data_with_nonrespondents) {
      raked_resp_rep_design <- rake_to_benchmarks(
        survey_design = orig_resp_rep_design,
        group_vars = input$t5_raking_group_vars,
        group_benchmark_vars = input$t5_raking_benchmark_vars
      )
      incProgress(amount = n)
    } else if (global_values$is_census_data_with_nonrespondents) {
      # Produce population counts for each raking variable, excluding known ineligibles
      pop_data_for_counts <- orig_rep_design$variables |>
        subset(
          get(input$response_eligibility_variable) != input$known_ineligible
        )
      incProgress(amount = n/3)
      benchmark_counts <- lapply(input$t5_raking_group_vars, function(var_name) {
        count_var_name <- paste0("RAKING_BENCHMARK_VAR_", var_name)
        count_df <- pop_data_for_counts |> dplyr::count(!!sym(var_name), name = count_var_name)
        #colnames(count_df)
        count_df
        #cat(paste0("\nCount_Df: ",str(count_df)))
      })
      incProgress(amount = n/3)
      # Add population counts to the dataset used for the analysis
      names(benchmark_counts) <- input$t5_raking_group_vars
      for (raking_group_var_name in names(benchmark_counts)) {
        
        orig_resp_rep_design$variables <- dplyr::left_join(
          x = orig_resp_rep_design$variables,
          y = as.data.frame(benchmark_counts[[raking_group_var_name]]),
          by = raking_group_var_name
        )
      }
      incProgress(amount = n/3)
      benchmark_vars <- paste0("RAKING_BENCHMARK_VAR_", input$t5_raking_group_vars)
      # Use the raking function
      raked_resp_rep_design <- rake_to_benchmarks(
        survey_design = orig_resp_rep_design,
        group_vars = input$t5_raking_group_vars,
        group_benchmark_vars = benchmark_vars
      )
    }
    
    # t_test_of_weight_adjustment(
    #   orig_design = orig_resp_rep_design, 
    #   updated_design = raked_resp_rep_design, 
    #   y_vars = wt_adj_comparison_vars
    # )
    
    param_list <<- list(
      "orig_design" = orig_resp_rep_design, 
      "updated_design" = raked_resp_rep_design, 
      "y_vars" = input$t5_wt_adj_comparison_vars
    )
    footer_value <<- sprintf(
      "The following variables were used to weight data from respondents: %s",
      paste(input$t5_raking_group_vars, collapse = ", ")
    )
    incProgress(amount = n)
    do.call(t_test_of_weight_adjustment, param_list)
  }, error = function(e) {
    return(e)
  })
  incProgress(amount = n)
  })
  
  output$analysis_output <- render_analysis_output(output_table)
  
})


```

```{r Identify variables that predict likelihood of responding}

observeEvent(input$analysis_predict_response, {
  global_values$last_analysis_clicked <- "analysis_predict_response"
}, ignoreInit = TRUE)

observeEvent(input$analysis_predict_response, {
  output$analysis_config <- renderUI({
    tagList(
      fluidRow(
        column(width = 6,
          selectizeInput(
            inputId = "t6_numeric_predictors",
            label = "Select numeric predictor variables to use in the regression model:",
            multiple = TRUE,
            choices = colnames(global_values$selected_data),
            options = list(placeholder = "[None]"),
            width = "95%"
          )     
        ),
        column(width = 6,
          selectizeInput(
            inputId = "t6_categorical_predictors",
            label = "Select categorical predictor variables to use in the regression model:",
            multiple = TRUE,
            choices = colnames(global_values$selected_data),
            options = list(placeholder = "[None]"),
            width = "95%"
          )
        )
      ),
      selectizeInput(
        inputId = "t6_model_selection",
        label = "Choose which of the predictor variables selected above to include in the regression model:",
        multiple = FALSE,
        choices = c(
          "All of the variables listed above" = "main-effects", 
          "A subset of the variables, chosen using stepwise model selection" = "stepwise"
        ),
        width = "95%"
      ),
      hidden(tags$div(
        id = "t6_selection_controls",
        numericInput(
          inputId = "t6_alpha_enter",
          label = "Maximum p-value for variable to enter model",
          value = 0.5,
          min = 0,
          max = 1
        ),
        numericInput(
          inputId = "t6_alpha_remain",
          label = "Maximum p-value for variable to remain in model",
          value = 0.5,
          min = 0,
          max = 1
        ),
        numericInput(
          inputId = "t6_max_iterations",
          label = "Maximum number of iterations for stepwise algorithm",
          value = 100,
          step = 1
        ) 
      )),
      actionButton("analysis_predict_response_submit", "Submit")
    )
  })
  
})

observeEvent(input$t6_model_selection, {
  if (input$t6_model_selection == "stepwise") {
    show("t6_selection_controls")
  } else {
    hide("t6_selection_controls")
  }
})

observeEvent(input$analysis_predict_response_submit, {
  routine_name <<- "predict_response_status_via_glm"
  routine_label <<- routines[which(routines$routine_name == routine_name), "routine_label"]
  withProgress(message = "Running Analysis...", {
    n = 1/5
    output_table <- tryCatch({
   
      if (global_values$respondents_only){
        stop("The dataset does not contain any eligible nonrespondents or cases with unknown eligibility.")
      }
      
      survey_design <- get_survey_design_object(
        data = global_values$selected_data, 
        input = input
      )
      incProgress(n)
      
      status_codes <- c(
        "ER" = input$eligible_respondents,
        "EN" = input$eligible_nonrespondents,
        "IE" = input$known_ineligible,
        "UE" = global_values$analysis_ue_category
      )
      
      selection_controls <- list(
        alpha_enter = input$t6_alpha_enter,
        alpha_remain = input$t6_alpha_remain,
        max_iterations = input$t6_max_iterations
      )
  
      param_list <<- list(
        "survey_design" = survey_design,
        "status" = "analysis_response_eligibility_variable", 
        "status_codes" = status_codes,
        "numeric_predictors" = input$t6_numeric_predictors,
        "categorical_predictors" = input$t6_categorical_predictors,
        "model_selection" = input$t6_model_selection,
        "selection_controls" = selection_controls
      )
      incProgress(n)
      
      result <- do.call(predict_response_status_via_glm, param_list)
      incProgress(n)
      # If there are categorical predictors, produce a text string
      # describing the reference levels in the regression
      ref_levels_table <- attr(result, 'reference_levels')
      if (!is.null(ref_levels_table)) {
        ref_levels_string <- sprintf(
          '%s "%s"',
          ref_levels_table[['variable']],
          ref_levels_table[['variable_category']]
        ) |> paste(collapse = "; ")
        ref_levels_string <- paste0(
          "For categorical predictor variables, the following categories were used as reference levels for the regression: ", 
          " ", ref_levels_string
        )
      } else {
        ref_levels_string <- NULL
      }
      footer_value <<- ref_levels_string
      incProgress(n)
  
      # Return the result
      result        
    }, error = function(e) {
      return(e)
    })
    incProgress(n)
  })
  
  output$analysis_output <- render_analysis_output(output_table)
  
})

```

```{r Identify variables that are predictive of survey outcomes}

observeEvent(input$analysis_aux_predictive, {
  global_values$last_analysis_clicked <- "analysis_aux_predictive"
}, ignoreInit = TRUE)

observeEvent(input$analysis_aux_predictive, {
  output$analysis_config <- renderUI({
    tagList(
      fluidRow(
        column(width = 6,
          selectizeInput(
            inputId = "t7_numeric_predictors",
            label = "Select numeric predictor variables to use in the regression model:",
            multiple = TRUE,
            choices = colnames(global_values$selected_data),
            options = list(placeholder = "[None]"),
            width = "95%"
          )     
        ),
        column(width = 6,
          selectizeInput(
            inputId = "t7_categorical_predictors",
            label = "Select categorical predictor variables to use in the regression model:",
            multiple = TRUE,
            choices = colnames(global_values$selected_data),
            options = list(placeholder = "[None]"),
            width = "95%"
          )
        )
      ),
      fluidRow(
        column(width = 6,
          selectizeInput(
            inputId = "t7_outcome_variable",
            label = "Select outcome variable.",
            multiple = FALSE,
            choices = colnames(global_values$selected_data),
            width = "95%",
            options = list(
              placeholder = '[None]',
              onInitialize = I('function() { this.setValue(""); }'))
          ),    
        ),
        column(width = 6,
          selectizeInput(
            inputId = "t7_outcome_type",
            label = "Choose type of outcome variable.",
            multiple = FALSE,
            choices = c("Numeric variable" = "continuous", "Binary categorical variable" = "binary"),
            width = "95%"
          )
        )
      ),
      hidden(selectizeInput(
        inputId = "t7_outcome_to_predict",
        label = "Choose category to predict.",
        multiple = FALSE,
        choices = c(""),
        options = list(placeholder = "[None]"),
        width = "95%"
      )),
      selectizeInput(
        inputId = "t7_model_selection",
        label = "Choose which of the predictor variables selected above to include in the regression model:",
        multiple = FALSE,
        choices = c(
          "All of the variables listed above" = "main-effects", 
          "A subset of the variables, chosen using stepwise model selection" = "stepwise"
        ),
        width = "95%"
      ),
      hidden(tags$div(
        id = "t7_selection_controls",
        numericInput(
          inputId = "t7_alpha_enter",
          label = "Maximum p-value for variable to enter model",
          value = 0.5,
          min = 0,
          max = 1
        ),
        numericInput(
          inputId = "t7_alpha_remain",
          label = "Maximum p-value for variable to remain in model",
          value = 0.5,
          min = 0,
          max = 1
        ),
        numericInput(
          inputId = "t7_max_iterations",
          label = "Maximum number of iterations for stepwise algorithm",
          value = 100,
          step = 1
        ) 
      )),
      actionButton("analysis_aux_predictive_submit", "Submit")
    )
  })
})

observeEvent(input$t7_outcome_variable, {
  
  if (length(input$t7_outcome_variable) > 0
      && input$t7_outcome_variable %in% colnames(global_values$selected_data)) {
    unique_outcomes_to_predict <- global_values$selected_data %>%
      pull(input$t7_outcome_variable) %>%
      unique()
    
    unique_outcomes_to_predict <- unique_outcomes_to_predict[
      !is.na(unique_outcomes_to_predict)
    ]
    
    updateSelectizeInput(
      inputId = "t7_outcome_to_predict",
      choices = unique_outcomes_to_predict
    ) 
  }

})

observeEvent(input$t7_outcome_type, {
  if (input$t7_outcome_type == "continuous") {
    hide("t7_outcome_to_predict")
  } else {
    show("t7_outcome_to_predict")
  }
})

observeEvent(input$t7_model_selection, {
  if (input$t7_model_selection == "stepwise") {
    show("t7_selection_controls")
  } else {
    hide("t7_selection_controls")
  }
})


observeEvent(input$analysis_aux_predictive_submit, {
  routine_name <<- "predict_outcome_via_glm"
  routine_label <<- routines[which(routines$routine_name == routine_name), "routine_label"]
  withProgress(message = "Running Analysis...", {
    n <- 1/4
    output_table <- tryCatch({
   
      survey_design <- get_survey_design_object(
        data = global_values$selected_data, 
        input = input
      )
      survey_design <- subset(
        survey_design,
        survey_design[['variables']][["analysis_response_eligibility_variable"]] == input$eligible_respondents
      )
      survey_design <- subset(
        survey_design,
        !is.na(get(input$t7_outcome_variable))
      )
      incProgress(n)
      
      selection_controls <- list(
        alpha_enter = input$t7_alpha_enter,
        alpha_remain = input$t7_alpha_remain,
        max_iterations = input$t7_max_iterations
      )
  
      param_list <<- list(
        "survey_design" = survey_design,
        "outcome_variable" = input$t7_outcome_variable,
        "outcome_type" = input$t7_outcome_type,
        "outcome_to_predict" = input$t7_outcome_to_predict,
        "numeric_predictors" = input$t7_numeric_predictors,
        "categorical_predictors" = input$t7_categorical_predictors,
        "model_selection" = input$t7_model_selection,
        "selection_controls" = selection_controls
      )
      result <- do.call(predict_outcome_via_glm, param_list)
      incProgress(n)
      
      # If there are categorical predictors, produce a text string
      # describing the reference levels in the regression
      ref_levels_table <- attr(result, 'reference_levels')
      if (!is.null(ref_levels_table)) {
        ref_levels_string <- sprintf(
          '%s "%s"',
          ref_levels_table[['variable']],
          ref_levels_table[['variable_category']]
        ) |> paste(collapse = "; ")
        ref_levels_string <- paste0(
          "For categorical predictor variables, the following categories were used as reference levels for the regression: ", 
          " ", ref_levels_string
        )
      } else {
        ref_levels_string <- NULL
      }
      footer_value <<- ref_levels_string
      incProgress(n)
      
      # Return the result
      result        
      
    }, error = function(e) {
      return(e)
    })
    incProgress(n)
  })
  
  output$analysis_output <- render_analysis_output(output_table)
  
})

```

```{r Assess how outcomes change as level-of-effort increases}

observeEvent(input$analysis_cumulative_estimates, {
  global_values$last_analysis_clicked <- "analysis_cumulative_estimates"
}, ignoreInit = TRUE)

observeEvent(input$analysis_cumulative_estimates, {
  output$analysis_config <- renderUI({
    tagList(
      selectizeInput(
        inputId = "t8_y_var",
        label = "Select the outcome variable for which estimates will be calculated:",
        multiple = TRUE,
        choices = colnames(global_values$selected_data),
        selected = NULL,
        options = list(placeholder = "[None]", maxItems = 1),
        width = "95%"
      ),
      selectizeInput(
        inputId = "t8_y_var_type",
        label = "Select type of variable for which estimates will be calculated:",
        multiple = FALSE,
        choices = c("Numeric variable" = "numeric", "Categorical variable" = "categorical"),
        width = "95%"
      ),
      selectizeInput(
        inputId = "t8_predictor_variable",
        label = "Choose the level-of-effort variable:",
        multiple = TRUE,
        choices = colnames(global_values$selected_data),
        selected = NULL,
        options = list(placeholder = "[None]", maxItems = 1),
        width = "95%"
      ),
      actionButton("analysis_cumulative_estimates_submit", "Submit")
    )
  })
})

observeEvent(input$analysis_cumulative_estimates_submit, {
  routine_name <<- "get_cumulative_estimates"
  routine_label <<- routines[which(routines$routine_name == routine_name), "routine_label"]
  withProgress(message = "Running Analysis...", {
    n <- 1/3
    output_table <- tryCatch({
   
      survey_design <- get_survey_design_object(
        data = global_values$selected_data, 
        input = input
      )
      incProgress(n)
      
      survey_design <- subset(
        survey_design,
        get(input$response_eligibility_variable) == input$eligible_respondents
      )
      incProgress(n)
  
      param_list <<- list(
        "survey_design" = survey_design,
        "y_var" = input$t8_y_var,
        "y_var_type" = input$t8_y_var_type,
        "predictor_variable" = input$t8_predictor_variable
      )
      footer_value <<- NULL
      do.call(get_cumulative_estimates, param_list)
          
    }, error = function(e) {
      return(e)
    })
    incProgress(n)
  })
  
  output$analysis_output <- render_analysis_output(output_table)
  
})

```

```{r Compare outcomes across subgroups}

observeEvent(input$analysis_across_subgroups, {
  global_values$last_analysis_clicked <- "analysis_across_subgroups"
}, ignoreInit = TRUE)

observeEvent(input$analysis_across_subgroups, {
  output$analysis_config <- renderUI({
    tagList(
      selectizeInput(
        inputId = "t9_grouping_variable",
        label = "Choose grouping variable:",
        multiple = FALSE,
        choices = colnames(global_values$selected_data),
        options = list(
          placeholder = '[None]',
          onInitialize = I('function() { this.setValue(""); }'))
      ),
      selectizeInput(
        inputId = "t9_outcome_variable",
        label = "Choose outcome variable:",
        multiple = FALSE,
        choices = colnames(global_values$selected_data),
        options = list(
          placeholder = '[None]',
          onInitialize = I('function() { this.setValue(""); }'))
      ),
      actionButton("analysis_across_subgroups_submit", "Submit")
    )
  })
})

observeEvent(input$analysis_across_subgroups_submit, {
  
  withProgress(message = "Running Analysis...", {
    n <- 1/8
    output_table <- tryCatch({
      routine_name <<- "analysis_across_subgroups"
      routine_label <<- routines[which(routines$routine_name == routine_name), "routine_label"]
      grouping_variable <- input$t9_grouping_variable
      outcome_variable <- input$t9_outcome_variable
        
      # Create example survey design ----
      survey_design <- get_survey_design_object(
          data = global_values$selected_data, 
          input = input
        )
      incProgress(n)
      
      # Subset the survey design object to relevant data ----
        survey_design <- survey_design |> srvyr::as_survey()
        
        if (!is.null(grouping_variable) && (grouping_variable != "")) {
          subsetted_survey_design <- survey_design |>
          srvyr::filter(!is.na(.data[[grouping_variable]]))
        }
        subsetted_survey_design <- survey_design |>
          srvyr::filter(!is.na(.data[[outcome_variable]]))
      incProgress(n)
      
        # Produce the desired output table ----
        output_table <- subsetted_survey_design |>
          srvyr::group_by(dplyr::across(dplyr::one_of(grouping_variable, outcome_variable))) |>
          srvyr::summarize(
            Percent = srvyr::survey_prop(vartype = "ci", proportion = TRUE, prop_method = "logit"),
            Weighted_Count = srvyr::survey_total(vartype = NULL),
            Unweighted_Count = srvyr::unweighted(n())
          ) |>
          ungroup() |>
          dplyr::arrange(dplyr::across(dplyr::one_of(outcome_variable, grouping_variable))) |>
          dplyr::rename_with(.fn = function(x) dplyr::case_when(
            x == "Percent_low" ~ "Lower_95_CI",
            x == "Percent_upp" ~ "Upper_95_CI",
            TRUE ~ x
      ))
      incProgress(n)
      
      status_codes <- c(
        "ER" = input$eligible_respondents,
        "EN" = input$eligible_nonrespondents,
        "IE" = input$known_ineligible,
        "UE" = global_values$analysis_ue_category
      )
      
      chisq_formula <- stats::reformulate(termlabels = c(outcome_variable, grouping_variable))
      incProgress(n)
      
      htest_obj <- tryCatch(
        survey::svychisq(
          design = subsetted_survey_design, 
          formula =  chisq_formula,
          statistic = "F"
        ),
        error = function(e) {list(
          "statistic" = NA,
          "p.value" = NA,
          "parameter" = c("ndf" = NA, "ddf" = NA)
        )}
      )
      incProgress(n)
      
      result_df <- data.frame(statistic = htest_obj[["statistic"]], 
                              ndf = htest_obj[["parameter"]][["ndf"]], ddf = htest_obj[["parameter"]][["ddf"]], 
                              p_value = htest_obj[["p.value"]],
                              test_method = "Rao-Scott Chi-Square test (second-order adjustment)")
      rownames(result_df) <- NULL
      incProgress(n)
      
      if (!is.na(result_df$p_value)) {
        p_value_text <- sprintf(
          "The test of whether the survey outcome, %s, differs among subgroups defined by %s has a p-value of %s, based on a Chi-squared test of independence.",
          outcome_variable, grouping_variable,
          format.pval(result_df$p_value, eps = 0.001)
        )
      } else {
        p_value_text <- paste0(
          "A Chi-squared test of independence could not be conducted",
          " due to perfect correlation between categories of the survey outcome and the grouping variable.",
          " Consider updating the grouping variable to use broader categories."
        )
      }
      incProgress(n)
    
      
      param_list <<- list(
        "survey_design" = survey_design, 
        "status" = "analysis_response_eligibility_variable", 
        "status_codes" = status_codes, 
        "aux_vars" = input$chisq_aux_variables,
        "grouping_variable" = input$t9_grouping_variable,
        "outcome_variable" = input$t9_outcome_variable
        )
      footer_value <<- p_value_text
      
      output_table
    }, error = function(e) {
      return(e)
    })
    incProgress(n)
  })
  output$analysis_output <- render_analysis_output(output_table)
})
```

```{r}
div(
  uiOutput("analysis_config"),
  uiOutput("analysis_output")
)

```


Report
=====================================

Column
-------------------------------------

### Download Report {data-height=40 .download-report}

```{r results='asis'}

# actionButton("save_report_docx", "Save to Word")
actionButton("save_report_xlsx", "Save to Excel")
#uiOutput("select_row_output")
```



### Items in Report

```{r}

get_report <- function(user_input = TRUE) {
  data_report <- data.frame(matrix(ncol=4,nrow=0, dimnames=list(NULL, c("type", "time", "title", "export"))))
  data_report <- data_report[order("Time"),]
  report_index <- 1
  previous_report_input_counter <<- report_input_counter
  title_index <- 1
  titles <- list()
  # loop through each analysis method
  for (i in 1:length(analysis_store)) {
    if (length(analysis_store[[i]]) > 0) {
      # loop through each submission
      for(j in 1:length(analysis_store[[i]])){
        if (length(analysis_store[[i]][[j]]) > 0 && !is.null(analysis_store[[i]][[j]][["type"]])){
          if (analysis_store[[i]][[j]][["title"]] %in% titles){
            analysis_store[[i]][[j]][["title"]] <- paste0(analysis_store[[i]][[j]][["title"]], "_",title_index)
            title_index <- title_index + 1
          } 
          titles[[report_index]] <- analysis_store[[i]][[j]][["title"]]
          data_report[report_index, "type"] <- toString(analysis_store[[i]][[j]][["type"]])
          data_report[report_index, "time"] <- toString(analysis_store[[i]][[j]][["time"]])
          
          if (user_input == TRUE) {
            # enabling textInput
            data_report[report_index, "title"] <- as.character(textInput(paste0("text_", (report_input_counter)), label = "", width = '70%', placeholder = analysis_store[[i]][[j]][["title"]]))
            # data_report[report_index, "title"] <- analysis_store[[i]][[j]][["title"]]
            data_report[report_index, "export"] <- as.character(checkboxInput(paste0("cb_", (report_input_counter)), label = "", value = TRUE, width = '5%'))
          } else {
            data_report[report_index, "title"] <- analysis_store[[i]][[j]][["title"]]
            data_report[report_index, "export"] <- analysis_store[[i]][[j]][["export"]]
          }
          #cat(str(colnames(analysis_store[[i]][[j]][["output"]][1])))
          report_input_counter <<- report_input_counter + 1
          report_index <- report_index + 1
        }
      }
    }
  }
  data_report <- data_report[, c("time", "title", "export")]
  return(data_report)
}

# datatable output

DT::DTOutput("output_report_df")

render_data_report <- function(report_summary_table) {
  report_summary_table <- report_summary_table[, c("time", "title", "export")]
  names(report_summary_table) <- c("Created On", "Title", "Include in Report")
  table <-
      DT::datatable(
      	data = report_summary_table,
      	class = "cell-border hover",
      	rownames = F,
      	escape = FALSE,
      	selection = 'none',
      	fillContainer = TRUE,
      	options = list(
      	  dom = "t",
      	  pageLength = nrow(report_summary_table),
      		columnDefs = list(
      		  list(targets = "_all", className = "dt-left"),
      		  list(targets = c(0, 2), width = "10%"),
      		  list(targets = c(1), width = "80%")
      		),
      	  preDrawCallback = DT::JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
          drawCallback = DT::JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      	)
      ) %>%
      DT::formatDate(1, method = "toLocaleString", params = list("en-US"))
  return(table)
}

observeEvent(input$active_tab, {
  if (input$active_tab != 3) {
    report_index <- 1
    for (i in 1:length(analysis_store)) {
      if (length(analysis_store[[i]]) > 0) {
        cat(paste0("\n2: ", str(input$active_tab)))
        for(j in 1:length(analysis_store[[i]])){
          if (length(analysis_store[[i]][[j]]) > 0 && !is.null(analysis_store[[i]][[j]][["type"]])) {
            if (isTruthy(input[[paste0("text_", (report_index + (previous_report_input_counter - 1)))]])) {
              # change analysis_store title if title has been editted
              if (input[[paste0("text_", (report_index + (previous_report_input_counter - 1)))]] != ''){
                analysis_store[[i]][[j]][["title"]] <<- input[[paste0("text_", (report_index + (previous_report_input_counter - 1)))]]
              }
            }
          }
          report_index <- report_index + 1
        }
      }
    }
  }
}, ignoreInit = TRUE)

observeEvent(input$save_report_xlsx, {
  excel_book <- createWorkbook(creator = "Westat")
  addWorksheet(excel_book, "Table of Contents")
  writeData(excel_book, "Table of Contents", x = matrix(c("ID", "Time", "Title"), nrow = 1), colNames = FALSE)
  # report index is used to check the true/false html tags from the report page
  report_index <- 1
  # table index is used to add values to excel data table
  table_index <- 1
  for (i in 1:length(analysis_store)) {
    if (length(analysis_store[[i]]) > 0) {
      # loop through each submission
      for(j in 1:length(analysis_store[[i]])){
        # report_index + (previous_report_input_counter - 1) keeps track of the html checkbox tags
        if (length(analysis_store[[i]][[j]]) > 0 && 
            !is.null(analysis_store[[i]][[j]][["type"]]) && 
            input[[paste0("cb_", (report_index + (previous_report_input_counter - 1)))]] == TRUE)
        {
          writeData(excel_book, "Table of Contents", x = table_index, table_index+1, startCol = 1)
          writeData(excel_book, "Table of Contents", x = toString(analysis_store[[i]][[j]][["time"]]), table_index+1, startCol = 2)
          sheet_name <- toString(table_index)
          addWorksheet(excel_book, sheet_name)
          # change analysis_store title if title has been editted
          if (input[[paste0("text_", (report_index + (previous_report_input_counter - 1)))]] != ''){
            analysis_store[[i]][[j]][["title"]] <<- input[[paste0("text_", (report_index + (previous_report_input_counter - 1)))]]
          }
          # add output table dictionary comments
          output_table <- analysis_store[[i]][[j]][["output"]]
          columns <- as.data.frame(colnames(output_table))
          colnames(columns) <- "column_name"
          routine_dictionary <- output_table_dictionary[which(output_table_dictionary$routine_name == analysis_store[[i]][[j]][["routine"]]),]
          columns <- left_join(columns, routine_dictionary)
          for (a in 1:nrow(columns)){
            if (!is.na(columns$description[a])){
              writeComment(excel_book, sheet_name, comment = createComment(comment = columns$description[a], visible = FALSE), row = 3, col = a)
            }
          }
         
          # round and add percentage to excel report
          for(z in 1:ncol(output_table)){
            if (is.double(output_table[,z]) && names(output_table)[z] %in% routine_dictionary$column_name) {
              output_table[,z] <- round(output_table[,z], digits = routine_dictionary$precision[which(names(output_table)[z] == routine_dictionary$column_name[routine_dictionary$routine_name == analysis_store[[i]][[j]][["routine"]]])])
            }
            if (names(output_table)[z] %in% routine_dictionary$column_name) {
              if (routine_dictionary$is_percentage[which(names(output_table)[z] == routine_dictionary$column_name)] == "Yes"){
                numFmt <- "0."
                # loops over how many digits for numFmt
                for(x in 1:(routine_dictionary$precision[which(names(output_table)[z] == routine_dictionary$column_name[routine_dictionary$routine_name ==analysis_store[[i]][[j]][["routine"]]])]-2)){
                  numFmt <- paste0(numFmt, "0")
                }
                numFmt <- paste0(numFmt, "%")
                addStyle(excel_book, sheet_name, style=createStyle(numFmt = numFmt), cols=z, rows = 3:(nrow(output_table)+3))
              }
              # highlighting
              if (routine_dictionary$is_emphasized[which(names(output_table)[z] == routine_dictionary$column_name)] == "Yes") {
                addStyle(excel_book, sheet_name, style=createStyle(textDecoration = "bold"), cols=z, rows = 3:(nrow(output_table)+3))
              }
            }
          }
          
          # change column names for output
          column_lookup <- routine_dictionary %>% 
            filter(nchar(short_label) > 0) %>%
            pull(column_name)
          names(column_lookup) <- routine_dictionary %>% 
            filter(nchar(short_label) > 0) %>%
            pull(short_label)
          column_lookup <- column_lookup[column_lookup %in% colnames(output_table)]
          output_table <- output_table %>%
            rename(column_lookup)
          
          # Write the content to the sheet: Title
          writeData(excel_book, sheet_name, x = analysis_store[[i]][[j]][["title"]], startRow = 1, startCol = 1)
          addStyle(
            wb = excel_book, sheet = sheet_name, 
            rows = 1, cols = seq_len(ncol(output_table)),
            style = createStyle(
              fontName = "Calibri", fontSize = 14, textDecoration = "bold",
              fontColour = "white", fgFill = "#4F81BD",
              borderStyle = "thin", border = c("Top", "Bottom"), borderColour = "black"
            )
          )
          # Write the content to the sheet: Table
          writeDataTable(excel_book, sheet_name, x = output_table, startRow = 3, withFilter = FALSE, tableStyle = "TableStyleMedium16")
          # Write the content to the sheet: Footer
          writeData(excel_book, sheet_name, x = analysis_store[[i]][[j]][["footer_value"]], startRow = 5+nrow(output_table))
          
          # Add a row to the table of contents
          writeFormula(excel_book, "Table of Contents",
  x = paste0('=HYPERLINK("#',sheet_name,'!A1", "',analysis_store[[i]][[j]][["title"]],'")'), startRow = table_index+1, startCol = 3)
          table_index <- table_index + 1
        }
        report_index <- report_index + 1
      }
    }
  }
  full_file_name <- file.path(tempdir(), "excel_book.xlsx")
  saveWorkbook(excel_book, file = full_file_name, overwrite = TRUE)
  report_as_base64 <- base64enc::base64encode(full_file_name)
  output$report_link_container <- renderUI({ HTML(paste0("<a id=\"report_link\" download=\"report.xlsx\" href=\"data:application/vnd.openxmlformats-officedocument.spreadsheetml.sheet;base64,", report_as_base64, "\">Download Report</a>")) });
  shinyjs::runjs("
    document.getElementById('save_report_xlsx').disabled = true;
    setTimeout(function() {
      document.getElementById('report_link').click();
      document.getElementById('save_report_xlsx').disabled = false;
    }, 1000)
  ");
  file.remove(full_file_name)
})

```

```{r}

uiOutput("select_row_output")

```



<external_link data-href="https://ideadata.org/resources/resource/2799/nonresponse-bias-analysis-application">NRBA App Reference Guide</external_link> {data-navmenu="Resources"}
=====================================


<external_link data-href="https://ideadata.org/">IDC - IDEA Data Center</external_link> {data-navmenu="Resources"}
=====================================


<!-- <link rel="shortcut icon" href="favicon-16x16.png"> -->
<link rel="stylesheet" type="text/css" href="css/style.css"/>
<script charset="utf-8" src="js/script.js">

