Fixed issue #39 and #56

for extracting coefficients for 'MPM' see discussion in see discussion in https://stackoverflow.com/questions/61164404/call-to-weight-in-lm-within-function-doesnt-evaluate-properly/61164660#61164660?newreg=04a2b71c6da04693a5b172a54a4a43b0
merliseclyde · Nov 9, 2022 · bb881c2 · bb881c2
1 parent d33f2bf
commit bb881c2
Show file tree

Hide file tree

Showing 3 changed files with 63 additions and 28 deletions.
diff --git a/R/coefficients.R b/R/coefficients.R
@@ -84,10 +84,16 @@ coef.bas <- function(object, n.models, estimator = "BMA", ...) {
     models <- rep(0, nvar + 1)
     models[bestmodel + 1] <- 1
     if (sum(models) > 1) {
+
+      # fix for issue #39 and #56 
+      modelform = as.formula(eval(object$call$formula, parent.frame()))
+      environment(modelform) = environment()
+      data = eval(object$call$data)
+      weights = eval(object$call$weights)
       object <- bas.lm(
-        eval(object$call$formula),
-        data = eval(object$call$data),
-        weights = eval(object$call$weights),
+        formula=modelform,
+        data = data,
+        weights = weights,
         n.models = 1,
         alpha = object$g,
         initprobs = object$probne0,

diff --git a/tests/testthat/test-bas-lm.R b/tests/testthat/test-bas-lm.R
@@ -317,29 +317,4 @@ test_that("as.matrix tools", {
 })
 
 
-# GitHub issue #56 and #42 
-
-test_that("formula and env issues with MPM",{
-  data(UScrime, package = "MASS")
-  UScrime <- UScrime[, 1:5]
-
-  crime.bic1 <- bas.lm(formula = M ~ So + Ed + Po1 + Po2,
-                      data = UScrime,
-                      prior = "JZS",
-                      initprobs = c(1, 0.5, 0.5, 0.5, 0.5),
-                      renormalize = TRUE)
-    coef.mpm1 <- coef(crime.bic1, estimator = "MPM")
-
-    form <- M ~ So + Ed + Po1 + Po2
-    crime.bic2 <- BAS::bas.lm(formula = form,
-                              data = UScrime,
-                              prior = "JZS",
-                              initprobs = c(1, 0.5, 0.5, 0.5, 0.5),
-                              renormalize = TRUE)
-
-    expect_error(coef.mpm2 = coef(crime.bic2, estimator = "MPM"))
-   # expect_equal(coef.mpm1, coef.mpm2)
-  }  
-)
-
 
diff --git a/tests/testthat/test-coefficients.R b/tests/testthat/test-coefficients.R
@@ -33,3 +33,57 @@ test_that("plot posterior coefficients", {
   expect_null(plot(crime_coef, ask=FALSE))
 })
 
+# GitHub issue #56 and #39
+
+test_that("formula and env issues with MPM",{
+  data(UScrime, package = "MASS")
+  UScrime <- UScrime[, 1:5]
+
+  crime.bic1 <- bas.lm(formula = M ~ So + Ed + Po1 + Po2,
+                       data = UScrime,
+                       prior = "JZS",
+                       initprobs = c(1, 0.5, 0.5, 0.5, 0.5),
+                       renormalize = TRUE)
+  coef.mpm1 <- coef(crime.bic1, estimator = "MPM")
+
+  form <- M ~ So + Ed + Po1 + Po2
+  crime.bic2 <- bas.lm(formula = form,
+                       data = UScrime,
+                       prior = "JZS",
+                       initprobs = c(1, 0.5, 0.5, 0.5, 0.5),
+                       renormalize = TRUE)
+
+  coef.mpm2 = coef(crime.bic2, estimator = "MPM")
+  expect_equal(coef.mpm1, coef.mpm2)
+}  
+)
+
+
+test_that("env and lm", {
+  data(UScrime, package = "MASS")
+  UScrime <- UScrime[, 1:5]
+
+  mylm = function(object) {
+    modelform = as.formula(eval(object$call$formula, parent.frame()))
+    environment(modelform) = environment()
+    data = eval(object$call$data)
+    weights = eval(object$call$weights)
+
+    object = lm(formula = modelform,
+                data = data,
+                weights = weights)
+   return(object) }
+
+
+  crime.lm1 <- lm(formula = M ~ So + Ed + Po1 + Po2, data = UScrime)  
+  tmp1 = mylm(crime.lm1)
+
+  form = M ~ So + Ed + Po1 + Po2
+  crime.lm2 <- lm(formula = form, data = UScrime)  
+
+  tmp = mylm(crime.lm2)
+
+  expect_equal(coef(tmp), coef(tmp1))
+
+})
+