Merge pull request #46 from priism-center/dev

updated clean detect ID
priism-center · Dec 14, 2023 · f1b634b · f1b634b
2 parents 52184f2 + 8724ff1
commit f1b634b
Show file tree

Hide file tree

Showing 3 changed files with 10 additions and 4 deletions.
diff --git a/thinkCausal/R/fct_clean.R b/thinkCausal/R/fct_clean.R
@@ -233,6 +233,8 @@ clean_detect_integers <- function(x, n_levels_threshold = 15){
 #' ID detection is based on column name and the values. If none are detected, then columns are categorized as 'X'
 #'
 #' @param .data a dataframe
+#' @param z string indicating named of selected treatment
+#' @param y string indicating name of selected response
 #'
 #' @author Joe Marlo & George Perrett
 #'
@@ -249,11 +251,11 @@ clean_detect_integers <- function(x, n_levels_threshold = 15){
 #' )
 #' clean_detect_ID_column(.data)
 
-clean_detect_ID_column <- function(.data) {
+clean_detect_ID_column <- function(.data, z, y) {
 
   # set list of potential column names to match
   ID_potentials <- c("^id")
-  all_col_names <- colnames(.data)
+  all_col_names <- colnames(.data)[colnames(.data) %notin% c(z, y)]
 
   # find ID columns
   ID_matches <- sapply(X = all_col_names, FUN = function(col){

diff --git a/thinkCausal/R/fct_create.R b/thinkCausal/R/fct_create.R
@@ -5,10 +5,10 @@
 #' @return html
 #'
 #' @noRd
-create_drag_drop_roles <- function(ns, .data, ns_prefix, exclude = NULL, include_all = FALSE, blocks = FALSE,random_effect = FALSE, weight = FALSE, default_weight = NULL, default_random_effects = NULL,default_blocks = NULL){
+create_drag_drop_roles <- function(ns, .data, ns_prefix, exclude = NULL, include_all = FALSE, blocks = FALSE,random_effect = FALSE, weight = FALSE, default_weight = NULL, default_random_effects = NULL,default_blocks = NULL, z = NULL, y = NULL){
   if (!inherits(.data, 'data.frame')) stop('.data must be a dataframe')
   # search for an ID variable
-  auto_columns <- clean_detect_ID_column(.data)
+  auto_columns <- clean_detect_ID_column(.data, z, y)
 
   # gather coviraiate names
   if(isFALSE(include_all)){

diff --git a/thinkCausal/R/mod_analysis_variable_selection.R b/thinkCausal/R/mod_analysis_variable_selection.R
@@ -389,6 +389,8 @@ mod_analysis_variable_selection_server <- function(id, store){
 
       drag_drop_html <- create_drag_drop_roles(ns = ns,
                                                .data = store$analysis_data_uploaded_df,
+                                               z = input$analysis_select_treatment,
+                                               y = input$analysis_select_outcome,
                                                ns_prefix = 'analysis_select',
                                                exclude = .exclude,
                                                include_all = input$analysis_select_include_all,
@@ -402,6 +404,8 @@ mod_analysis_variable_selection_server <- function(id, store){
       return(drag_drop_html)
     })
 
+
+    # reactive function to run checks over selected varaibles
     check_variable_assignment <- reactive({
       # remove any previous dataframes from the store
       store <- remove_downstream_data(store, page = 'select')