DS-4148 Remove the need to assign .design to .GlobalEnv

.travis.yml

@@ -28,7 +28,6 @@ r_packages:
 
 r_github_packages:
   - Displayr/flipDevTools
-  - CRAN/[email protected]
   - Displayr/flipExampleData
 
 script:

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: flipRegression
 Type: Package
 Title: Estimates standard regression models
-Version: 1.3.50
+Version: 1.3.51
 Author: Displayr <[email protected]>
 Maintainer: Displayr <[email protected]>
 Description: Regression models according to the flip Project
@@ -27,14 +27,13 @@ Imports: car,
  rhtmlHeatmap,
  stats,
  sure,
- survey,
+ survey (>= 4.1.1),
  verbs,
  xml2
 Suggests: flipExampleData,
  testthat,
  robustbase
 Remotes:
- cran/[email protected],
  Displayr/flipU,
  Displayr/flipFormat,
  Displayr/flipData,

R/regression.R

@@ -1194,7 +1194,7 @@ fitModel <- function(.formula, .estimation.data, .weights, type, robust.se, subs
                 model$df <- NA
             else
             {
-                assign(".design", .design, envir=.GlobalEnv)
+                assign(".design", .design, environment(.formula))
                 aic <- try(extractAIC(model), silent = TRUE)
                 if (any("try-error" %in% class(aic)))
                 {
@@ -1203,7 +1203,6 @@ fitModel <- function(.formula, .estimation.data, .weights, type, robust.se, subs
                             "some aspect of the analysis. ")
                     aic <- rep(NA, 2)
                 }
-                remove(".design", envir=.GlobalEnv)
                 model$df <- aic[1]
                 model$aic <- aic[2]
             }
@@ -1241,9 +1240,8 @@ fitModel <- function(.formula, .estimation.data, .weights, type, robust.se, subs
                                                family = poisson()),
                             "Quasi-Poisson" = svyglm(.formula, .design, subset = non.outlier.data_GQ9KqD7YOf,
                                                      family = quasipoisson()))
-            assign(".design", .design, envir=.GlobalEnv)
+            assign(".design", .design, envir = environment(.formula))
             aic <- extractAIC(model)
-            remove(".design", envir=.GlobalEnv)
             model$df <- aic[1]
             model$aic <- aic[2]
         }
@@ -1496,6 +1494,7 @@ fitOrderedLogit <- function(.formula, .estimation.data, weights, non.outlier.dat
             # predictor.
             class(out) <- c("svyolr", "polr")
             # Retain the design and formula for later use
+            assign(".design", .design, envir = environment(.formula))
             out$formula <- .formula
             out$design <- .design
             out
@@ -1526,8 +1525,8 @@ findAppropriateStartingValueForOrderedLogit <- function(.formula, .estimation.da
     first.level <- levels(y)[1]
     cut.point <- substr(first.level, 4L, nchar(first.level))
     q1 <- which(levels(.estimation.data[[outcome.name]]) == cut.point)
-    logit <- function(p) log(p/(1 - p))
-    spacing <- logit((1L:q)/(q + 1L))
+    logit <- function(p) log(p / (1 - p))
+    spacing <- logit((1L:q) / (q + 1L))
     gammas <- -coefs[1L] + spacing - spacing[q1]
     c(coefs[-1L], gammas)
 }
@@ -1699,11 +1698,13 @@ findNonOutlierObservations <- function(data, outlier.prop.to.remove, model, type
         {
             if (!is.null(weights))
             {
-                assign(".design", model$design, envir=.GlobalEnv)
-                assign(".formula", model$formula, envir=.GlobalEnv)
+                assign(".design", model$design, envir = sys.frame())
+                assign(".formula", model$formula, envir = sys.frame())
                 model.residuals <- resids(model, method = "latent")
-                remove(".design", envir=.GlobalEnv)
-                remove(".formula", envir=.GlobalEnv)
+                if (identical(sys.frame(), .GlobalEnv)) {
+                    remove(".design", envir = sys.frame())
+                    remove(".formula", envir = sys.frame())
+                }
             } else
                 model.residuals <- resids(model, method = "latent")
         }
@@ -2437,7 +2438,7 @@ reduceOutputSize <- function(fit)
     ## remove environment attribute to reduce size
     attr(fit$terms, ".Environment") <- c()
     attr(original$terms, ".Environment") <- c()
-    attr(original$formula, ".Environment") <- c()
+    #attr(original$formula, ".Environment") <- c()
     attr(attr(original$model, "terms"), ".Environment") <- c()
     attr(fit$summary$formula, ".Environment") <- c()
     attr(fit$summary$terms, ".Environment") <- c()

tests/testthat/test-automatedoutlierremoval.R

@@ -85,9 +85,9 @@ test_that("Weighted Ordered Logit (svyolr)", {
     expect_error(regression <- Regression(bank.formula[["Ordered Logit"]], data = small.bank, weights = weight,
                                           type = "Ordered Logit", outlier.prop.to.remove = 0),
                  NA)
-    non.outlier.data <- flipRegression:::findNonOutlierObservations(data = small.bank, outlier.prop.to.remove = 0.1,
-                                                                    model = regression$original, type = "Ordered Logit",
-                                                                    weights = small.bank$weight, seed = 12321)
+    non.outlier.data <- findNonOutlierObservations(data = small.bank, outlier.prop.to.remove = 0.1,
+                                                   model = regression$original, type = "Ordered Logit",
+                                                   weights = small.bank$weight, seed = 12321)
     expected.error.message <- paste0("Removing outliers has removed all the observations in the outcome variable with",
                                      " level(s): 7. If possible, this issue could be solved by merging the categories ",
                                      "of the outcome variable or reducing the Automated Outlier removal setting.")
@@ -224,12 +224,12 @@ test_that("Consistent structure with automated outlier removal", {
     expect_false(identical(automated.removal.linear$coef, basic.linear$coef))
     expect_equal(basic.linear$coef, lm(bank.formula[["Linear"]], data = small.bank)$coefficients)
     n.data <- nrow(basic.linear$estimation.data)
-    computed.subset <- flipRegression:::findNonOutlierObservations(data = basic.linear$estimation.data,
-                                                                   model = lm(bank.formula[["Linear"]],
-                                                                              data = basic.linear$estimation.data),
-                                                                   outlier.prop.to.remove = proportion,
-                                                                   type = "Linear",
-                                                                   weights = NULL)
+    computed.subset <- findNonOutlierObservations(data = basic.linear$estimation.data,
+                                                  model = lm(bank.formula[["Linear"]],
+                                                             data = basic.linear$estimation.data),
+                                                  outlier.prop.to.remove = proportion,
+                                                  type = "Linear",
+                                                  weights = NULL)
     expect_equal(computed.subset, automated.removal.linear$non.outlier.data)
     manually.computed.subset <- rank(abs(basic.linear$original$residuals)) <= ceiling(n.data * (1 - proportion))
     expect_equivalent(computed.subset, manually.computed.subset)