modify design environment solution

R/modify_design.R

@@ -38,36 +38,36 @@ modify_design <- function(design, ...) {
   causal_order <- design$causal_order
   original_env <- design$causal_order_env
 
-  # modify_env <- freeze_environment(parent.frame())
-
-  # overlap_names <-
-  #   ls(modify_env)[ls(modify_env) %in% ls(original_env)]
-  #
-  # ## show warning if there is any overlap in objects, say they will NOT be replaced
-  # if (length(overlap_names) > 0) {
-  #   warning(
-  #     paste0(
-  #       "Note that some of the objects in your global environment currently were also used in your original design. The version of ",
-  #       paste(overlap_names, collapse = ", "),
-  #       " created before declare_design will be used."
-  #     )
-  #   )
-  # }
-  #
-  # ## add any parts of modify_env to original_env that are NOT in original env
-  #
-  # ##for(ls(modify_env)[!(ls(modify_env) %in% overlap_names)])
-  #
-  # ## for(n in ls(e1, all.names = TRUE)) assign(n, get(n, e1), e2)
-  #
+  modify_env <- freeze_environment(parent.frame())
+
+  ## check whether objects with overlapping names are identical
+
+  overlap_names <-
+    ls(modify_env)[ls(modify_env) %in% ls(original_env)]
+
+  overlap_identical <- sapply(overlap_names, function(i) identical(get(i, envir = original_env), get(i, envir = modify_env)))
+
+  ## throw warning if any overlapping object *has changed*
+
+  if(any(overlap_identical == FALSE)){
+    warning(paste0("Some of the objects in your workspace have changed since you declared the design, including ",
+                   paste(overlap_names[overlap_identical == FALSE], collapse = ","), ". The original object will be used from when you declared the design."))
+  }
+
+  ## add objects that are not in the original env (do not overwrite modified objects)
+
+  new_objects_modify <- ls(modify_env)[!(ls(modify_env) %in% ls(original_env))]
+
+  for(n in new_objects_modify) {
+    assign(n, get(n, modify_env), original_env)
+  }
 
   dots <- lazy_dots(...)
   dots_funcs <- sapply(dots, function(x)
     deparse(x$expr[[1]]))
 
   for (i in seq_along(dots)) {
 
-
     ## add step
     if (dots_funcs[i] ==  "add_step") {
       step_names <- names(dots[[i]]$expr)
@@ -137,10 +137,13 @@ modify_design <- function(design, ...) {
 
     }
   }
+
   new_design <- do.call(what = declare_design,
                         args = causal_order,
                         envir = original_env)
-  new_design
+
+  return(new_design)
+
 }
 
 #' Modify a Design by Adding Steps

tests/testthat/test-modify-design.R

@@ -10,13 +10,14 @@ test_that("test the full declare design setup", {
   my_potential_outcomes <- declare_potential_outcomes(Y_Z_0 = noise, Y_Z_1 = noise + rnorm(N, mean = 2, sd = 2))
 
   my_assignment <- declare_assignment(m = 25)
-  my_assignment_2 <- declare_assignment(m = 25, assignment_variable_name = "Z2")
 
   design <- declare_design(my_population,
                            my_potential_outcomes,
                            dplyr::mutate(q = 5),
                            my_assignment)
 
+  my_assignment_2 <- declare_assignment(m = 25, assignment_variable_name = "Z2")
+
   test <- modify_design(design, replace_step(my_assignment_2, replace = my_assignment))
 
   test <- modify_design(design, add_step(dplyr::mutate(blah = 6), before = my_potential_outcomes))
@@ -40,6 +41,7 @@ test_that("test the full declare design setup", {
 })
 
 
+
 test_that("placement doesn't matter", {
   my_population <- declare_population(N = 100, noise = rnorm(N))