How to properly plot ICE in R?

Question

I want to plot Individual Conditional Expectation (ICE), and I have the following code segment:

library(caret)
library(gridExtra)
library(grid)
library(ggridges)
library(ggthemes)
library(iml)
library(partykit)
library(rpart)
library(tidyverse)

theme_set(theme_minimal())
set.seed(88)

kfolds <- 3

load_dataset <- function() {
  dataset <- read_csv("https://gist.githubusercontent.com/dmpe/bfe07a29c7fc1e3a70d0522956d8e4a9/raw/7ea71f7432302bb78e58348fede926142ade6992/pima-indians-diabetes.csv", col_names=FALSE)  %>%
    mutate(X9=as.factor(ifelse(X9== 1, "diabetes", "nondiabetes")))
  X = dataset[, 1:8]
  Y = dataset$X9
  return(list(dataset, X, Y))
}

compute_rf_model <- function(dataset) {
  index <- createDataPartition(dataset$X9,
                               p=0.8,
                               list=FALSE,
                               time=1)

  dataset_train <- dataset[index,]
  dataset_test <- dataset[-index,]

  fit_control <- trainControl(method="repeatedcv",
                              number=kfolds,
                              repeats=1,
                              classProbs=TRUE,
                              savePredictions=TRUE,
                              verboseIter=FALSE,
                              allowParallel=FALSE,
                              summaryFunction=defaultSummary)

  rf_model <- train(X9~.,
                    data=dataset_train,
                    method="rf",
                    preProcess=c("center","scale"),
                    trControl=fit_control,
                    metric="Accuracy",
                    verbose=FALSE)
  return(list(rf_model, dataset_train, dataset_test))
}


main <- function() {
  data <- load_dataset()
  dataset <- data[[1]]
  X <- data[[2]]
  Y <- data[[3]]

  rf_model_data <- compute_rf_model(dataset)
  rf_model <- rf_model_data[[1]]
  dataset_train <- rf_model_data[[2]]
  dataset_test <- rf_model_data[[3]]

  X <- dataset_train    %>%
    select(-X9) %>%
    as.data.frame()

  predictor <- Predictor$new(rf_model, data=X, y=dataset_train$X9)

  ice <- FeatureEffect$new(predictor, feature="X2", center.at=min(X$X2), method="pdp+ice")
  ice_plot_glucose <- ice$plot() + 
    scale_color_discrete(guide="none") +
    scale_y_continuous("Predicted Diabetes")
  ice <- FeatureEffect$new(predictor, feature="X4", center.at=min(X$X4), method="pdp+ice")
  ice_plot_insulin <- ice$plot() + 
    scale_color_discrete(guide="none") +
    scale_y_continuous("Predicted Diabetes")
  grid.arrange(ice_plot_glucose, ice_plot_insulin, ncol=1)

}

if (!interactive()) {
  main()
} else if (identical(environment(), globalenv())) {
  quit(status = main())
}

The plot that I receive at the end looks like this:

And this plot does not look nearly as nice some ICE plots online, such as this one below:

Any ideas why is this happening? I believe the data that I have is similar to the one shown in above post, at least value-wise.

Answer 1

The problem is that the predictor gives the class labels instead of the class probabilities.

Changing

predictor <- Predictor$new(rf_model, data=X, y=dataset_train$X9)

to

predictor <- Predictor$new(rf_model, data=X, y=dataset_train$X9, type = "prob")

should fix your plots.

See these fixed PD plots