将所有观察结果的 Shapley 原因代码附加到整个数据答案

【问题标题】：Append Shapley reason codes on all observations to the entire data将所有观察结果的 Shapley 原因代码附加到整个数据
【发布时间】：2018-11-20 02:16:14
【问题描述】：

这是我在 mtcars 数据集上获取前 5 个 Shaply 原因代码的代码。

#install.packages("randomForest"); install.packages("tidyverse"); install.packages(""iml)
library(tidyverse); library(iml); library(randomForest) 

set.seed(42)

mtcars1 <- mtcars %>%  mutate(vs = as.factor(vs),
                              id = row_number())

x <- "vs"
y <- paste0(setdiff(setdiff(names(mtcars1), "vs"), "id"), collapse = "+")

rf = randomForest(as.formula(paste0(x, "~ ", y)), data = mtcars1, ntree = 50)

predictor = Predictor$new(rf, data = mtcars1, y = mtcars1$vs)


shapley = Shapley$new(predictor, x.interest = mtcars1[1,])

shapleyresults <- as_tibble(shapley$results) %>% arrange(desc(phi)) %>% slice(1:5) %>% select(feature.value, phi)

如何获取所有观察结果的原因代码（而不是在上述代码的倒数第二行中一次一个：mtcars[1,]）？
然后，使用 id 将 shapleyresults 追加/left_join 到整个数据集？

数据集将长 5 倍。我们应该在这里使用 purrr 吗？

【问题讨论】：

标签： r tidyverse purrr

【解决方案1】：

我找到了解决办法。

#install.packages("randomForest"); install.packages("tidyverse"); install.packages("iml")
library(tidyverse); library(iml); library(randomForest) 

set.seed(42)

mtcars1 <- mtcars %>%  mutate(vs = as.factor(vs),
                              id = row_number())

x <- "vs"
y <- paste0(setdiff(setdiff(names(mtcars1), "vs"), "id"), collapse = "+")

rf = randomForest(as.formula(paste0(x, "~ ", y)), data = mtcars1, ntree = 50)

predictor <- Predictor$new(rf, data = mtcars1, y = mtcars1$vs)

shapelyresults <- map_dfr(1:nrow(mtcars), ~(Shapley$new(predictor, x.interest = mtcars1[.x,]) %>% 
                                              .$results %>% 
                                              as_tibble() %>% 
                                              arrange(desc(phi)) %>% 
                                              slice(1:5) %>% 
                                              select(feature.value, phi) %>%
                                              mutate(id = .x)))

final_data <- mtcars1 %>% left_join(shapelyresults, by = "id")

【讨论】：