---
title: "Explanation Groves"
subtitle: "Analyzing the Trade-off between Complexity and Adequacy of an Explanation"
author: "Gero Szepannek, Stralsund University of Applied Sciences"
date: last-modified
date-format: "10-07-2024"
title-slide-attributes:
  data-background-image: logo.jpg
  data-background-size: 10%
  data-background-position: 2% 2%
format: 
  revealjs:
    theme: dark
    slide-number: c/t
bibliography: references.bib
---


## Flexibility vs. Interpretability {.r-fit-text}

::: {style="font-size:28px"}
![](ISLR27.png){width=80%}

@ISLR
:::


## Motivation

:::: {.columns}

::: {.column width="55%"}
::: {style="font-size:32px"}

- @ec24: EU AI Act 
- @buecker20: <span style="color:lightblue;">TAX4CS</span>  framework 
- @molnar22: pitfalls 
- @gosiewska19: additivity 
- @biecek_context: context 
- @rudin19: reasons against using XAI
- @szepannek22: analyzing limits of interpretability 

:::
:::

::: {.column width="45%"}

![](pyramid.png){width=100%}

:::
:::

## Example: Boston Housing Data

::: {style="font-size:32px"}
```{r, echo = FALSE}

library(pdp)
data(boston)
str(boston)

set.seed(42)
ids <- sample(nrow(boston), round(0.8*nrow(boston)))
train <- boston[ids, ]
test  <- boston[-ids,]
```

- @boston
- 80:20 Split in training and validation data.
::: 


## Moitivation (II): Performance vs. Interpretability

::: {style="font-size:32px"}

- Decision Tree [@therneau15]
- ...vs. RF [@fernandez14; @wright17]. 
- No HPT [@szepannek17; @probst21].
- <span style="color:lightblue;">Forest better but no longer interpretable due to large number of rules!</span>
- Humans' working memory capacity limited [@miller56; @cowan10].

```{r, echo = FALSE}
set.seed(42)

pred0 <- mean(train$cmedv)
sse0  <- sum((pred0 - test$cmedv)^2)

library(rpart)
rp <- rpart(cmedv ~ ., data = train)

ssep <- sum((predict(rp, test) - test$cmedv)^2) 
r2p  <- 1- ssep/sse0  # 0.739
cmp_p <- nrow(rp$frame[rp$frame$var != "<leaf>",])   # 8


# library(randomForest)
# rf <- randomForest(cmedv ~ ., data = train)
library(ranger)
rf <- ranger(cmedv ~ ., data = train)

ssef <- sum((predict(rf, test)$predictions - test$cmedv)^2)  
r2f  <- 1- ssef/sse0  # 0.836

nrules_rf <- 0
for(i in 1:rf$num.trees){
  tinf <- treeInfo(rf, i)
  nrules_rf <- nrules_rf + nrow(tinf) - sum(tinf$terminal) # number of rules
}
cmp_f <- nrules_rf # 64341

res <- round(cbind(c(r2p, cmp_p), c(r2f, cmp_f)), 3)
rownames(res) <- c("Test R²", "# rules")
colnames(res) <- c("rpart", "ranger")

library(knitr)
kable(res)

# reps <- 200
# boot.ci <- numeric(reps)
# for(i in 1:reps){
#   tnew <- test[sample(nrow(test), replace = T), ]
#   sse0i  <- sum((pred0 - tnew$cmedv)^2)
#   ssefi <- sum((predict(rf, tnew)$predictions - tnew$cmedv)^2)  
#   boot.ci[i]  <- 1- ssefi/sse0i  
# } 
# quantile(boot.ci, c(0.025, 0.975))


#data <- boston[,-3] # remove target variable
#ntrees <- c(4,8,16,32,64,128)
#xg <- xgrove(rf, data, ntrees)
#xg
#plot(xg)
```


:::

## Explanation Groves...

::: {style="font-size:30px"}

- Create surrogate model [@molnar22book; @banerjee12] 
- ...using the predictions of the model to be interpreted on training data as target variable.

- Adequacy of the explanation (XAI) can be assessed via explainability $\Upsilon = 1 - \frac{ESD(XAI)}{ESD(\emptyset)}$ [@szepannek23] with 

$$ ESD(XAI) = \int (\hat{f}(X) - XAI(X))^2 \; d P(X) $$

- Gradient boosting [@friedman01] maximizes explainability within each step...
- ...using tree stumps adds one single rule per iteration.


- <span style="color:lightblue;">Result:</span> a set of interpretable rules...
- ...where number of rules can be controlled by the number of boosting iterations.

:::

## An Artificial Example

```{r, echo = FALSE}
x <- seq(0, 2*pi, by=0.01)
y <- sin(x)
plot(x,y, type = "l", ylab = "Model Response")
sg  <- gbm::gbm(y ~ x, n.trees = 256, shrinkage = 1, bag.fraction = 1, distribution = "gaussian")
```


## Explanation with 2 Rules 
```{r, echo = FALSE}
nt <- 1
plot(x,y, type = "l", ylab = "Model Response", main = paste("Explanation with", nt+1, "rules"))
predictions      <- predict(sg, data.frame(x), n.trees = nt)
lines(x, predictions, col = 4)

ASE <-  mean((y - predictions)^2)
ASE0 <- mean((y - mean(y))^2)
upsilon <- 1 - ASE / ASE0
text(4.9, 0.95, expression(Upsilon))
text(5, 0.95, "=")
text(5.2, 0.95, round(upsilon,3))

```

## Explanation with 5 Rules 
```{r, echo = FALSE}
nt <- 4
plot(x,y, type = "l", ylab = "Model Response", main = paste("Explanation with", nt+1, "rules"))
predictions      <- predict(sg, data.frame(x), n.trees = nt)
lines(x, predictions, col = 4)

ASE <-  mean((y - predictions)^2)
ASE0 <- mean((y - mean(y))^2)
upsilon <- 1 - ASE / ASE0
text(4.9, 0.95, expression(Upsilon))
text(5, 0.95, "=")
text(5.2, 0.95, round(upsilon,3))
```

## Explanation with 17 Rules 
```{r, echo = FALSE}
nt <- 16
plot(x,y, type = "l", ylab = "Model Response", main = paste("Explanation with", nt+1, "rules"))
predictions      <- predict(sg, data.frame(x), n.trees = nt)
lines(x, predictions, col = 4)

ASE <-  mean((y - predictions)^2)
ASE0 <- mean((y - mean(y))^2)
upsilon <- 1 - ASE / ASE0
text(4.9, 0.95, expression(Upsilon))
text(5, 0.95, "=")
text(5.2, 0.95, round(upsilon,3))
```

## Explanation with 65 Rules 
```{r, echo = FALSE}
nt <- 64
plot(x,y, type = "l", ylab = "Model Response", main = paste("Explanation with", nt+1, "rules"))
predictions      <- predict(sg, data.frame(x), n.trees = nt)
lines(x, predictions, col = 4)

ASE <-  mean((y - predictions)^2)
ASE0 <- mean((y - mean(y))^2)
upsilon <- 1 - ASE / ASE0
text(4.9, 0.95, expression(Upsilon))
text(5, 0.95, "=")
text(5.2, 0.95, round(upsilon,3))
```


## Code Demo on Boston Housing data

::: {style="font-size:32px"}
```{r, echo = TRUE, eval=FALSE}
library(ranger)
rf <- ranger(cmedv ~ ., data = train)

library(xgrove)
data <- train[,-3] # remove target variable
ntrees <- c(4,8,16,32,64,128)
xg <- xgrove(rf, data, ntrees, pfun = function(model, data) return(predict(model, data)$predictions))
```
:::


## Rules to Explain the ranger model 

::: {style="font-size:32px"}
```{r, echo = F}
library(xgrove)
data <- train[,-3] # remove target variable
ntrees <- c(4,8,16,32,64,128)
xg <- xgrove(rf, data, ntrees, pfun = function(model, data) return(predict(model, data)$predictions))

kable(xg$rules[["8"]])
```
:::


## Trade off

```{r, echo = FALSE}
plot(xg)
abline(v = 10, col = "grey", lty = "dotted")
abline(h = 0.9, col = "grey", lty = "dotted")
```





## Summary

:::: {.columns}

::: {.column width="70%"}
::: {style="font-size:32px"}
- Flexibility vs Interpretability
- Explanation Groves: 
   - extract set of explainable rules that maximize explainability $\Upsilon$,
   - at the same time control complexity of the explanation,
   - analyze trade-off between complexity and adequacy of an explanation. 
- (!) There does not necessarily exist an easy explanation of a complex model.
- Implementeted in the R package <span style="color:lightblue;">xgrove</span>.  

:::

::::

::: {.column width="30%"}

::: {style="font-size:24px"}

![](logo_xgrove_transp.png){width=120%}

Available on CRAN.

::: 

:::

:::

## Thank You!
