Logical on-off matrices

Author: mayer79

NEWS.md

@@ -18,6 +18,10 @@
   parallel mode, thanks [#163](https://github.com/ModelOriented/kernelshap/issues/163)
   for reporting. We have added a note in the function documentation that this warning
   can be ignored.
+  
+### Internal changes
+
+- Matrices holding on-off vectors are now consistently of type logical ([#167](https://github.com/ModelOriented/kernelshap/pull/167)).
 
 # kernelshap 0.8.0
 

R/utils.R

@@ -49,14 +49,14 @@ wcolMeans <- function(x, w = NULL, ...) {
 #'
 #' @param p Number of features.
 #' @param feature_names Feature names.
-#' @returns An integer matrix of all on-off vectors of length `p`.
+#' @returns An logical matrix of all on-off vectors of length `p`.
 exact_Z <- function(p, feature_names) {
   if (p < 2L) {
     stop("p must be at least 2 if exact = TRUE.")
   }
   m <- 2^p
   M <- seq_len(m) - 1L
-  encoded <- as.integer(intToBits(M))
+  encoded <- as.logical(intToBits(M))
   dim(encoded) <- c(32L, m)
   Z <- t(encoded[p:1L, , drop = FALSE])
   colnames(Z) <- feature_names
@@ -74,15 +74,12 @@ exact_Z <- function(p, feature_names) {
 #' @inheritParams kernelshap
 #' @param x Row to be explained.
 #' @param bg Background data stacked m times.
-#' @param Z A (m x p) matrix with on-off values (logical or integer).
+#' @param Z A logical (m x p) matrix with on-off values.
 #' @param w A vector with case weights (of the same length as the unstacked
 #'   background data).
 #' @returns A (m x K) matrix with vz values.
 get_vz <- function(x, bg, Z, object, pred_fun, w, ...) {
   m <- nrow(Z)
-  if (!is.logical(Z)) {
-    storage.mode(Z) <- "logical"
-  }
   n_bg <- nrow(bg) / m # because bg was replicated m times
 
   # Replicate Z, so that bg and Z are of dimension (m*n_bg x p)

R/utils_kernelshap.R

@@ -121,7 +121,7 @@ sample_Z <- function(p, m, feature_names, S = 1:(p - 1L)) {
   # t(out)
 
   # Vectorized by Mathias Ambuehl
-  out <- rep(rep.int(0:1, m), as.vector(rbind(p - N, N)))
+  out <- rep(rep.int(c(FALSE, TRUE), m), as.vector(rbind(p - N, N)))
   dim(out) <- c(p, m)
   ord <- order(col(out), sample.int(m * p))
   out[] <- out[ord]
@@ -143,7 +143,7 @@ input_sampling <- function(p, m, deg, feature_names) {
   }
   S <- (deg + 1L):(p - deg - 1L)
   Z <- sample_Z(p = p, m = m / 2, feature_names = feature_names, S = S)
-  Z <- rbind(Z, 1 - Z)
+  Z <- rbind(Z, !Z)
   w_total <- if (deg == 0L) 1 else 1 - 2 * sum(kernel_weights(p)[seq_len(deg)])
   w <- w_total / m
   list(Z = Z, w = rep.int(w, m), A = crossprod(Z) * w)
@@ -198,17 +198,18 @@ partly_exact_Z <- function(p, k, feature_names) {
   }
   if (k == 1L) {
     Z <- diag(p)
+    storage.mode(Z) <- "logical"
   } else {
     Z <- t(
       utils::combn(seq_len(p), k, FUN = function(z) {
-        x <- numeric(p)
-        x[z] <- 1
+        x <- logical(p)
+        x[z] <- TRUE
         x
       })
     )
   }
   if (p != 2L * k) {
-    Z <- rbind(Z, 1 - Z)
+    Z <- rbind(Z, !Z)
   }
   colnames(Z) <- feature_names
   Z

R/utils_permshap.R

@@ -240,15 +240,15 @@ init_vzj <- function(p, v0, v1) {
 #' @noRd
 #' @keywords internal
 #'
-#' @param mask The output of `exact_Z(p, feature_names)`.
+#' @param mask Logical matrix. The output of `exact_Z(p, feature_names)`.
 #' @returns List with p elements, each containing an `on` and `off` vector.
 positions_for_exact <- function(mask) {
   p <- ncol(mask)
   codes <- seq_len(nrow(mask)) # Row index = binary code of the row
 
   positions <- vector("list", p)
   for (j in seq_len(p)) {
-    on <- codes[as.logical(mask[, j])]
+    on <- codes[mask[, j]]
     off <- on - 2^(p - j) # trick to turn "bit" off
     positions[[j]] <- list(on = on, off = off)
   }

backlog/compare_with_python.R

@@ -14,7 +14,7 @@ bg_X <- diamonds[seq(1, nrow(diamonds), 450), ]
 # Subset of 1018 diamonds to explain
 X_small <- diamonds[seq(1, nrow(diamonds), 53), c("carat", ord)]
 
-# Exact KernelSHAP (2s)
+# Exact KernelSHAP (1.8s)
 system.time(
   ks <- kernelshap(fit, X_small, bg_X = bg_X)
 )
@@ -25,23 +25,23 @@ ks
 # [1,] -2.050074 -0.28048747 0.1281222 0.01587382
 # [2,] -2.085838  0.04050415 0.1283010 0.03731644
 
-# Pure sampling version takes a bit longer (7 seconds)
+# Pure sampling version takes a bit longer (6.6 seconds)
 system.time(
   ks2 <- kernelshap(fit, X_small, bg_X = bg_X, exact = FALSE, hybrid_degree = 0)
 )
 ks2
 
 bench::mark(kernelshap(fit, X_small, bg_X = bg_X, verbose=F))
-# 2.17s 1.64GB -> 1.72s 1.44GB
+# 2.17s 1.64GB -> 1.79s 1.43GB
 
 bench::mark(kernelshap(fit, X_small, bg_X = bg_X, verbose=F, exact=F, hybrid_degree = 1))
 # 4.88s  2.79GB ->  4.38s 2.48GB
 
 bench::mark(permshap(fit, X_small, bg_X = bg_X, verbose=F))
-# 1.97s 1.64GB -> 1.8s 1.43GB
+# 1.97s 1.64GB -> 1.9s 1.43GB
 
 bench::mark(permshap(fit, X_small, bg_X = bg_X, verbose=F, exact=F))
-# 3.04s  1.88GB ->  2.9s 1.64GB
+# 3.04s  1.88GB ->  2.8s 1.64GB
 
 # SHAP values of first 2 observations:
 #          carat     clarity     color        cut