如何在 R 中正确绘制 ICE?

How to properly plot ICE in R?

我想绘制个人条件期望 (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 在线图那么好,比如下面这个:

知道为什么会这样吗?我相信我拥有的数据与上面显示的数据相似 post,至少在价值方面是这样。

问题是预测器给出了 class 标签而不是 class 概率。

改变

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

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

应该修复你的情节。

见these fixed PD plots