untracked! Dummy adjusted importance

When dummy variable adjustment is used, the adjustment variables are
remvoed from the model before importance analysis is conducted (and the
estimation data updated). The estimation data should be inspected and
the variables checked against the formula and dummy variables searched.

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: flipData
 Type: Package
 Title: Functions for extracting and describing data
-Version: 1.5.4
+Version: 1.5.5
 Author: Displayr <opensource@displayr.com>
 Maintainer: Displayr <opensource@displayr.com>
 Description: Functions for extracting data from formulas and

R/checks.R

@@ -129,12 +129,19 @@ CheckPredictionVariables <- function(object, newdata)
     dummy.adjusted.importance <- regression.model &&
         object$missing == "Dummy variable adjustment" &&
         !is.null(object$importance.type)
+    formula.exists <- "formula" %in% names(object)
     # LDA transforms the model data into a model matrix (dummy variable encoding), so is not appropriate
-    if ("formula" %in% names(object) && !dummy.adjusted.importance && !inherits(object, "LDA"))
+    if (formula.exists && !dummy.adjusted.importance && !inherits(object, "LDA"))
     {
         training.model.variables <- AllVariablesNames(object[["formula"]], data = object[["model"]])
         training.outcome.name    <- OutcomeName(object[["formula"]], data = object[["model"]])
         relevant.cols <- training.model.variables[training.model.variables != training.outcome.name]
+    } else if (formula.exists && dummy.adjusted.importance) {
+        original.model <- object[["original"]]
+        formula.vars <- AllVariablesNames(object[["formula"]])[-1L]
+        dummy.vars <- names(object[["estimation.data"]])[grepl("dummy\\.var_GQ9KqD7YOf$", names(object[["estimation.data"]]))]
+        relevant.vars <- union(formula.vars, dummy.vars)
+        relevant.cols <- names(object[["estimation.data"]])[names(object[["estimation.data"]]) %in% relevant.vars]
     } else # Relevant for older CART which don't have a formula (see DS-2488)
         relevant.cols <- names(object[["model"]])[names(object[["model"]]) != object[["outcome.name"]]]
     # Check if a regression object is being processed and the outlier removal has been implemented.

tests/testthat/test-checks.R

@@ -170,4 +170,17 @@ test_that("DS-3488 Check dummy variable adjustment handled with and without outl
     expected.output <- missing.all.predictors[-1, -1]
     expect_equal(CheckPredictionVariables(output, newdata = dummy.adj.model),
                  dummy.adj.model[, c("X1", "X2")])
+    # Check estimation data is used and only uses the correct variables after Importance analysis
+    input.ed <- data.frame(Response = 1, w = 1, y = 1, z = 1, x.dummy.var_GQ9KqD7YOf = 1,
+                           non.outlier.data_GQ9KqD7YOf = TRUE)
+    new.data <- input.ed[2:5]
+    object <- structure(list(formula = Response ~ w + x + y + z + x.dummy.var_GQ9KqD7YOf + z.dummy.var_GQ9KqD7YOf,
+                             missing =  "Dummy variable adjustment",
+                             model = data.frame(Response = 1, w = 1, y = 1, z = 1,
+                                                x.dummy.var_GQ9KqD7YOf = 1,
+                                                z.dummy.var_GQ9KqD7YOf = 1),
+                             importance.type = "Shapley Regression",
+                             estimation.data = input.ed),
+                        class = "Regression")
+    expect_equal(CheckPredictionVariables(object, input.ed), new.data)
 })