fix formulae with spaces bug (closes #80)

leeper · Jan 10, 2018 · 9cffafb809bcbe3ecb284d8de9540d13097f9b85 · 9cffafb
1 parent 5eaf510
commit 9cffafb809bcbe3ecb284d8de9540d13097f9b85
Unified Split

Showing with 14 additions and 10 deletions.

+1 −1 DESCRIPTION

+1 −1 LICENSE

+4 −0 NEWS.md

+1 −1 R/find_terms_in_model.R

+4 −4 R/formulae.R

+3 −3 R/print.R
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -4,7 +4,7 @@ Title: Marginal Effects for Model Objects
 Description: An R port of Stata's 'margins' command, which can be used to
     calculate marginal (or partial) effects from model objects.
 License: MIT + file LICENSE
-Version: 0.3.8
+Version: 0.3.9
 Date: 2018-01-10
 Authors@R: c(person("Thomas J.", "Leeper",
                     role = c("aut", "cre"), 

diff --git a/LICENSE b/LICENSE
@@ -1,2 +1,2 @@
-YEAR: 2014-2017
+YEAR: 2014-2018
 COPYRIGHT HOLDER: Thomas J. Leeper
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,7 @@
+## margins 0.3.9
+
+* Fixed a bug wherein model formulae involving non-standard variables names with spaces in them led to errors. (#80)
+
 ## margins 0.3.8
 
 * Added method for "svyglm" from **survey**.

diff --git a/R/find_terms_in_model.R b/R/find_terms_in_model.R
@@ -8,7 +8,7 @@ find_terms_in_model <- function(model, variables = NULL) {
     # handle character variables as factors
     classes[classes == "character"] <- "factor"
     ## cleanup names of terms
-    terms2 <- sapply(names(classes), function(x) all.vars(parse(text = x)))
+    terms2 <- sapply(names(classes), function(x) all.vars(parse(text = paste0("`", x, "`"))))
     names(classes)[names(classes) %in% names(terms2)] <- terms2[names(classes) %in% names(terms2)]
 
     # identify factors versus numeric terms in `model`

diff --git a/R/formulae.R b/R/formulae.R
@@ -1,14 +1,14 @@
 # function to cleanup I(), etc. in formulas
 gsub_bracket <- function(a, b) {
     tmp <- regmatches(a, gregexpr(paste0("(",b,"\\().+(\\))"), a))
-    regmatches(a, gregexpr(paste0("(",b,"\\().+(\\))"), a)) <- 
-      gsub(")$","", gsub(paste0("^",b,"\\("), "", tmp))
+    regmatches(a, gregexpr(paste0("(",b,"\\().+(\\))"), a)) <- gsub(")$","", gsub(paste0("^",b,"\\("), "", tmp))
     a
 }
 
 # function to drop multipliers, powers, etc.
 drop_operators <- function(a, dropdigits = TRUE) {
-    a <- gsub(" ","",a)
+    # drop leading or trailing spaces ?
+    a <- gsub(" +$", "", gsub("^ +","",a))
     # remove mathematical operators
     if(dropdigits) {
         a <- gsub("^[:digit:]+(\\^|\\+|\\-|\\*|\\|/|,)", "", a)
@@ -27,7 +27,7 @@ drop_operators <- function(a, dropdigits = TRUE) {
     a
 }
 
-# call sub_bracket on all common formula operations
+# call gsub_bracket on all common formula operations
 clean_terms <- function(terms) {
     v <- gsub_bracket(terms, "factor")
     v <- gsub_bracket(v, "ordered")

diff --git a/R/print.R b/R/print.R
@@ -20,9 +20,9 @@ function(x, digits = 4, order = NULL, ...) {
         tmp <- marginal_effects(x, with_at = FALSE)
         names(tmp) <- gsub("^dydx_", "", names(tmp))
         if (isTRUE(is_weighted)) {
-            out <- data.frame(lapply(tmp, stats::weighted.mean, w = wts, na.rm = TRUE))
+            out <- data.frame(lapply(tmp, stats::weighted.mean, w = wts, na.rm = TRUE), check.names = FALSE)
         } else {
-            out <- data.frame(lapply(tmp, mean, na.rm = TRUE))
+            out <- data.frame(lapply(tmp, mean, na.rm = TRUE), check.names = FALSE)
         }
         print(out, digits = digits, row.names = FALSE, ...)
     } else {
@@ -39,7 +39,7 @@ function(x, digits = 4, order = NULL, ...) {
             xby <- x[ , attr(x, "at"), drop = FALSE]
             splits <- split(tmp, xby)
             out <- do.call("rbind", lapply(splits, function(set) {
-                cbind(set[1L, attr(x, "at"), drop = FALSE], data.frame(lapply(set[, !names(set) %in% c("_weights", attr(x, "at")), drop = FALSE], stats::weighted.mean, w = set[["_weights"]], na.rm = TRUE)))
+                cbind(set[1L, attr(x, "at"), drop = FALSE], data.frame(lapply(set[, !names(set) %in% c("_weights", attr(x, "at")), drop = FALSE], stats::weighted.mean, w = set[["_weights"]], na.rm = TRUE), check.names = FALSE))
             }))
         } else {
             tmp <- x[, grepl("^dydx_", names(x)), drop = FALSE]