In johacks/bncounterfactuals: COUNTERFACTUAL AND SUFFICIENT EXPLANATIONS FOR BAYESIAN NETWORKS

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
knitr::write_bib("bnlearn", file = "packages.bib")

library(bncounterfactuals)
library(bnlearn)

Persuasive Explanations

Persuasive explanations of a classifier output given an input $X$ are a tuple $$, where $S$ is a set of sufficient explanations and $C$ is a set of counterfactual explanations. Sufficient explanations are subsets of the explanatory variables such that, if they have the same values as in the original input $X$, the output of the classifier will remain the same regardless of the value of the rest of the variables. Counterfactual explanations are the opposite: value assignations to a subset of the explanatory variables such that, if they all have different values from the original assignation in $X$, and the other variables remain with the same value, the output changes.

BFS_SFX

BFS_SFX [@koopman2021persuasive] is an algorithm to find sufficient explanations for the output of a Bayesian Network, but may also be used for almost any classifier. Below is a use example, where one sufficient explanation is obtained for the output "Fallot": with XrayReport = "Oligaemic", it is enough to get the same output: "Fallot". Note that given the use of an approximate inference algorithm with few available variables, this explanation may change due to the inherent randomness of the algorithm.

set.seed(40)
download.file("https://www.bnlearn.com/bnrepository/child/child.rda",
              "child.rda", "auto", quiet = TRUE)
load("child.rda")  # Load CHILD Bayesian Network
evidence = data.frame(
  LVHReport=factor(x = "yes", levels = dimnames(bn$LVHreport$prob)[[1]]),
  LowerBodyO2=factor(x = "5-12", levels = dimnames(bn$LowerBodyO2$prob)[[1]]),
  CO2Report=factor(x = "<7.5", levels = dimnames(bn$CO2Report$prob)[[1]]),
  XrayReport=factor(x = "Oligaemic", levels = dimnames(bn$XrayReport$prob)[[1]])
)
target <- predict(object = bn, node = bn$Disease$node, data = evidence,
                 method = "bayes-lw")
print("Classification input (see dataframe):")
print(evidence)
print("Classification output:")
print(target)
expected <- factor("TGA", levels = levels(target))
print("Expected output was:")
print(expected)
predict_f <- function(df) {
  predict(object = bn, node = bn$Disease$node, data = df, method = "bayes-lw", n = 500000)}
print("Sufficient explanation for the output:")
str(bfs_sfx(predict_f, evidence, target, expected))

BFS_CFX

BFS_CFX [@koopman2021persuasive] is an algorithm to find counterfactual explanations for the output of a Bayesian Network, but may also be used for almost any classifier. It is applied in a similar fashion to BFS_CFX (shown above). The output for the next example gives possible counterfactual explanations that would have given the output "TGA" if the rest of the variables maintain the same values.

print("Classification input (see dataframe):")
print(evidence)
print("Classification output:")
print(target)
print("Expected output was:")
print(expected)
print("Counterfactual explanations for the output:")
str(bfs_cfx(predict_f, evidence, target, expected))

BFS_SFX_CFX

BFS_SFX_CFX [@koopman2021persuasive] is a combination of both algorithms above that computes at the same time counterfactual and sufficient explanations of an outcome. The different pairs that can be formed with the sufficient explanations and the counterfactual explanations are called persuasive explanations. The algorithm is used similarly to both above:

print("Classification input (see dataframe):")
print(evidence)
print("Classification output:")
print(target)
print("Expected output was:")
print(expected)
print("Persuasive explanations for the output:")
str(bfs_sfx_cfx(predict_f, evidence, target, expected))

Using a helper function for bnlearn

A wrapper function is provided to use this algorithm with a Bayesian Network as implemented in bnlearn [@R-bnlearn]. The main advantage is that it allows to set a threshold for classification of the MLE. Currently setting a threshold for each label is not allowed, and it is planned to make a change to include this feature soon, as it is a limited policy.

# Predict most likely label if posterior prob > 0.20 else predict TGA
predict_f <- bnlearn_predict_wrapper(bn, bn$Disease$node, "bayes-lw",
                                     threshold=0.20, default="TGA")
print(bfs_sfx(predict_f, evidence, target, expected))

johacks/bncounterfactuals documentation built on March 29, 2022, 10:13 p.m.