--- title: "Gradient SHAP" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Gradient SHAP} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE) ``` # Example usage ```{r, fig.width=7.5} library(misc) # Create test functions library(MASS) # 1. Nonlinear function with interactions f_polynomial <- function(X) { X <- as.matrix(X) X[,1]^2 + 2*X[,2] + 0.5*X[,1]*X[,2] + 0.1*X[,3]^3 } # 2. Neural network-like function f_neural <- function(X) { X <- as.matrix(X) tanh(X[,1] + 2*X[,2]) + sin(X[,3]) + X[,1]*X[,2] } # 3. Exponential function f_exponential <- function(X) { X <- as.matrix(X) exp(0.1*X[,1]) + log(abs(X[,2]) + 1) + sqrt(abs(X[,3]) + 1) } # Generate test data set.seed(42) n_train <- 100 n_test <- 5 X_train <- matrix(rnorm(n_train * 3), nrow = n_train, ncol = 3) colnames(X_train) <- c("x1", "x2", "x3") X_test <- matrix(rnorm(n_test * 3), nrow = n_test, ncol = 3) colnames(X_test) <- c("x1", "x2", "x3") cat("=== Testing Gradient-Based SHAP Methods ===\n\n") # Test 1: Polynomial function cat("1. Polynomial Function: x1² + 2x2 + 0.5x1*x2 + 0.1x3³\n") result_grad <- gradient_shap(f_polynomial, X_train, X_test, h = 1e-4) cat("Gradient SHAP - Max residual:", round(result_grad$max_residual, 4), "\n") result_ig <- integrated_gradients(f_polynomial, X_train, X_test, n_steps = 20, h = 1e-4) cat("Integrated Gradients - Max residual:", round(result_ig$max_residual, 4), "\n") result_lime <- local_linear_shap(f_polynomial, X_train, X_test, n_samples = 500) cat("Local Linear - Max residual:", round(result_lime$max_residual, 4), "\n") cat("Predictions:", round(result_grad$predictions, 4), "\n") cat("Gradient SHAP attributions:\n") print(round(result_grad$attributions, 4)) cat("Integrated Gradients attributions:\n") print(round(result_ig$attributions, 4)) cat("\n") # Test 2: Neural network-like function cat("2. Neural-like Function: tanh(x1 + 2x2) + sin(x3) + x1*x2\n") result_neural <- gradient_shap(f_neural, X_train, X_test) cat("Max residual:", round(result_neural$max_residual, 4), "\n") cat("RMSE residual:", round(result_neural$rmse_residual, 4), "\n") cat("Predictions:", round(result_neural$predictions, 4), "\n") cat("Attributions:\n") print(round(result_neural$attributions, 4)) cat("\n") # Test 3: Exponential function cat("3. Exponential Function: exp(0.1x1) + log(|x2|+1) + sqrt(|x3|+1)\n") result_exp <- gradient_shap(f_exponential, X_train, X_test, baseline_method = "median") cat("Max residual:", round(result_exp$max_residual, 4), "\n") cat("Predictions:", round(result_exp$predictions, 4), "\n") cat("Attributions:\n") print(round(result_exp$attributions, 4)) cat("\n") # Comparison of methods for polynomial function cat("=== Method Comparison (Polynomial Function) ===\n") cat("True function: x1² + 2x2 + 0.5x1*x2 + 0.1x3³\n") cat("Test point:", round(X_test[1,], 4), "\n") cat("True prediction:", round(f_polynomial(X_test[1,,drop=FALSE]), 4), "\n\n") cat("Gradient SHAP attributions:", round(result_grad$attributions[1,], 4), "\n") cat("Integrated Gradients:", round(result_ig$attributions[1,], 4), "\n") cat("Local Linear:", round(result_lime$attributions[1,], 4), "\n") cat("\nResiduals (smaller = better):\n") cat("Gradient SHAP:", round(result_grad$residuals[1], 4), "\n") cat("Integrated Gradients:", round(result_ig$residuals[1], 4), "\n") cat("Local Linear:", round(result_lime$residuals[1], 4), "\n") # EXPLICIT DECOMPOSITION VERIFICATION cat("\n=== EXPLICIT DECOMPOSITION CHECK ===\n") cat("For first test point:\n") # Check each method methods <- list( "Gradient SHAP" = result_grad, "Integrated Gradients" = result_ig, "Local Linear" = result_lime ) for (method_name in names(methods)) { result <- methods[[method_name]] cat("\n", method_name, ":\n", sep="") cat(" Prediction:", round(result$predictions[1], 6), "\n") cat(" Base value:", round(result$baseline_prediction, 6), "\n") cat(" Sum of attributions:", round(sum(result$attributions[1,]), 6), "\n") cat(" Base + Sum:", round(result$baseline_prediction + sum(result$attributions[1,]), 6), "\n") cat(" Residual:", round(result$residuals[1], 6), "\n") cat(" Decomposition valid?", abs(result$residuals[1]) < 1e-5, "\n") # More reasonable threshold } # Show the mathematical relationship more clearly cat("\n=== MATHEMATICAL VERIFICATION ===\n") pred <- result_ig$predictions[1] base <- result_ig$baseline_prediction attrs <- result_ig$attributions[1,] cat("Mathematical check for Integrated Gradients:\n") cat("prediction =", round(pred, 6), "\n") cat("base_value + sum(attributions) =", round(base, 6), "+", round(sum(attrs), 6), "=", round(base + sum(attrs), 6), "\n") cat("Difference =", round(abs(pred - (base + sum(attrs))), 10), "\n") cat("Passes additivity test:", abs(pred - (base + sum(attrs))) < 1e-5, "\n") ```