Implement additive force plots

[bgreenwell]

See here for examples. Here's a cheap hack using reticulate:

force_plot <- function(object, ...) {
  UseMethod("force_plot")
}

force_plot.explain <- function(object, prediction = NULL, baseline = NULL, 
                               feature_values = NULL,...) {
  object <- (object / sum(object)) * (prediction - baseline)
  shap <- reticulate::import("shap")
  fp <- shap$force_plot(
    base_value = baseline, 
    shap_values = data.matrix(object),
    features = data.matrix(feature_values),
    feature_names = names(object),
    matplotlib = FALSE,
    ...
  )
  tfile <- tempfile(fileext = ".html")
  shap$save_html(tfile, plot_html = fp)
  # Check for dependency
  if (requireNamespace("rstudioapi", quietly = TRUE)) {
    rstudioapi::viewer(tfile)
  } else if (requireNamespace("utils", quietly = TRUE)) {
    utils::browseURL(tfile)
  } else {
    stop("Packages \"rstudioapi\" or \"utils\" needed for this function to ",
         "work. Please install one of them.", call. = FALSE)
  }
}

[bgreenwell]

Minimal example:

# Load required packages
library(fastshap)  # for fast (approximate) Shapley values
library(mlbench)   # for Friedman 1 benchmark data set
library(ranger)    # for fast random forest algorithm

# Simulate training data
set.seed(101)
trn <- as.data.frame(mlbench.friedman1(3000))
X <- subset(trn, select = -y)  # feature columns only

# Fit a random forest
set.seed(102)
rfo <- ranger(y ~ ., data =  trn)

# Prediction wrapper
pfun <- function(object, newdata) {
  predict(object, data = newdata)$predictions
}

# Compute fast (approximate) Shapley values using 10 Monte Carlo repetitions
system.time({  # estimate run time
  set.seed(5038)
  ex <- explain(rfo, X = X, pred_wrapper = pfun, nsim = 10)
})

# Construct force plot
force_plot(ex[1, ], prediction = pfun(rfo, X[1, ]), 
           baseline = mean(pfun(rfo, X)), feature_values = X[1, ])