Fixed Issue paulponcet#2 works with ns now

spgarbet · Oct 4, 2022 · 9cdddb5 · 9cdddb5
1 parent 5f14f1d
commit 9cdddb5
Show file tree

Hide file tree

Showing 4 changed files with 13 additions and 8 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: strip
 Type: Package
 Title: Lighten your R Model Outputs
-Version: 1.0.0
+Version: 1.0.1
 Date: 2018-09-30
 Authors@R: person("Paul", "Poncet", , "paulponcet@yahoo.fr", role = c("aut", "cre"))
 Description: The strip function deletes components of R model outputs that are useless for specific purposes, such as predict[ing], print[ing], summary[izing], etc.
@@ -19,7 +19,8 @@ Suggests:
     randomForest, 
     stats, 
     testthat,
-    utils
+    utils,
+    splines
 URL: https://github.com/paulponcet/strip
 BugReports: https://github.com/paulponcet/strip/issues
 RoxygenNote: 6.1.0
diff --git a/R/strip_.glm.R b/R/strip_.glm.R
@@ -39,7 +39,7 @@ function(object,
     op$family$aic <- NULL
     op$family$validmu <- NULL
     op$family$simulate <- NULL
-    attr(op$terms,".Environment") <- NULL
+    #attr(op$terms,".Environment") <- NULL
     attr(op$formula,".Environment") <- NULL
 
   } else {

diff --git a/R/strip_.lm.R b/R/strip_.lm.R
@@ -30,7 +30,7 @@ function(object,
     op$prior.weights <- NULL
     op$linear.predictors <- NULL
 
-    attr(op$terms,".Environment") <- NULL
+    #attr(op$terms,".Environment") <- NULL
     attr(op$formula,".Environment") <- NULL
 
   } else if ("predictci" %in% keep) {
@@ -44,7 +44,7 @@ function(object,
     op$prior.weights <- NULL
     op$linear.predictors <- NULL
 
-    attr(op$terms,".Environment") <- NULL
+    #attr(op$terms,".Environment") <- NULL
     attr(op$formula,".Environment") <- NULL
 
   } else {

diff --git a/tests/testthat/test-strip.R b/tests/testthat/test-strip.R
@@ -1,10 +1,11 @@
 context("Strip")
 
+library(splines)
 test_that("predict.lm works correctly after stripping", {
   set.seed(111)
   mtcars <- datasets::mtcars
   i <- sample(2, nrow(mtcars), replace = TRUE, prob = c(0.8, 0.2))
-  r1 <- stats::lm(mpg ~ ., data = mtcars[i == 1,])
+  r1 <- stats::lm(mpg ~ cyl + ns(disp,2)+hp+drat+wt+qsec+vs+am+gear+carb, data = mtcars[i == 1,])
   r2 <- strip(r1, keep = "predict")
   p1 <- stats::predict(r1, newdata = mtcars[i == 2,])
   p2 <- try(stats::predict(r2, newdata = mtcars[i == 2,]), silent = TRUE)
@@ -27,13 +28,16 @@ test_that("print.lm works correctly after stripping", {
 test_that("predict.glm works correctly after stripping", {
   ldose <- rep(0:5, 2)
   numdead <- c(1, 4, 9, 13, 18, 20, 0, 2, 6, 10, 12, 16)
+
   sex <- factor(rep(c("M", "F"), c(6, 6)))
+  other<-rnorm(12)
   SF <- cbind(numdead, numalive = 20-numdead)
   ld <- seq(0, 5, 0.1)
-  r1 <- stats::glm(SF ~ sex*ldose, family = binomial)
+  r1 <- stats::glm(SF ~ sex*ldose+ns(other,2), family = binomial)
   r2 <- strip(r1, keep = "predict")
   df <- data.frame(ldose = ld,
-                  sex = factor(rep("M", length(ld)), levels = levels(sex)))
+                  sex = factor(rep("M", length(ld)), levels = levels(sex)),
+                  other=rnorm(length(ld)))
   p1 <- stats::predict(r1, newdata = df, type = "response")
   p2 <- try(stats::predict(r2, newdata = df, type = "response"), silent = TRUE)