Tukukkk

Here is my code to get the top 5 Shaply reason codes on mtcars dataset.

#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)

1. How can I get the reason codes for all the observations (instead of one at a time in the 2nd last line in the above code: mtcars[1,])?


2. 
   

   And, append/left_join the shapleyresults using id on to the entire dataset?

   
   
   

   The dataset would be 5-times longer. Should we use purrr here to do that?

   
   

I found the solution.

#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")