Merge pull request #85 from saadaslam/master

re-writing glm/lm parsing to account for bug when variable names are …

R/model-lm.R

@@ -136,11 +136,13 @@ parse_label_lm <- function(label, vars) {
       col = items[i]
     )
     cat_match <- map_lgl(vars, ~ .x == substr(items[i], 1, nchar(.x)))
-    if (any(cat_match) && vars[cat_match] != items[i]) {
+    if (any(cat_match) && any(vars[cat_match] != items[i]) && !(items[i] %in% vars)) {
+      cat_match_vars <- vars[cat_match]
+      sole_cat_match <- cat_match_vars[rank(-nchar(cat_match_vars))][[1]]
       item <- list(
         type = "conditional",
-        col = vars[cat_match],
-        val = substr(items[i], nchar(vars[cat_match]) + 1, nchar(items[i])),
+        col = sole_cat_match,
+        val = substr(items[i], nchar(sole_cat_match) + 1, nchar(items[i])),
         op = "equal"
       )
     }

tests/testthat/test_glm.R

@@ -19,6 +19,20 @@ test_that("Intervals return a call", {
   )
 })
 
+test_that("tidypredict works when variable names are subset of other variables", {
+  df2 <- df
+  df2$wt_sq <- df2$wt ^ 2
+  df2$char_cyl = as.character(df2$cyl)
+  set.seed(22)
+  df2$char_cyl_2 = sample(letters[1:3], size = nrow(df2), replace = TRUE)
+  model4 <- suppressWarnings(glm(
+    am ~ wt + wt_sq + char_cyl + char_cyl_2, 
+    data = df2, family = "binomial"
+  ))
+  expect_silent(tidypredict_fit(model4))
+  expect_false(tidypredict_test(model4)$alert)
+})
+
 context("glm-saved")
 test_that("Model can be saved and re-loaded", {
   model <- glm(am ~ wt + disp + cyl, data = df, family = "binomial")

tests/testthat/test_lm.R

@@ -13,6 +13,20 @@ test_that("Predictions within threshold and parsed model results are equal", {
   expect_false(has_alert(lm(mpg ~ (wt + disp) * cyl, data = df)))
 })
 
+test_that("tidypredict works when variable names are subset of other variables", {
+  df2 <- df
+  df2$wt_sq <- df2$wt ^ 2
+  df2$char_cyl = as.character(df2$cyl)
+  df2$char_cyl_2 = sample(letters[1:3], size = nrow(df2), replace = TRUE)
+  model4 <- lm(
+    am ~ wt + wt_sq + char_cyl + char_cyl_2, 
+    data = df2
+  )
+
+  expect_silent(tidypredict_fit(model4))
+  expect_false(tidypredict_test(model4)$alert)
+})
+
 context("lm-parsnip")
 
 lm_parsnip <- function(...) {