Как правильно построить ICE в R?

Question

Я хочу построить Индивидуальное условное ожидание (ICE), и у меня есть следующий сегмент кода:

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())
}

График, который я получаю в конце, выглядит следующим образом:

И этот график выглядит не так хорошо, как некоторые онлайн-сюжеты ICE, такие как приведенный ниже:

Есть идеи, почему это происходит?Я полагаю, что данные, которые у меня есть, похожи на те, что показаны в посте выше, по крайней мере, по стоимости.

Answer 1

Проблема в том, что предиктор дает метки классов вместо вероятностей классов.

Изменение

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

до

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

должен исправить ваши сюжеты.

См. эти фиксированные графики PD