0
点赞
收藏
分享

微信扫一扫

R语言机器学习mlr3:模型解释

芝婵 2022-03-24 阅读 96

目录

关于模型解释平常接触的不是特别多,简单学习下。

理论上,所有通用的模型解释框架都可应用于mlr3,只需要把训练好的模型从Learner对象中提取出来即可。

目前最受欢迎的两个框架分别是:

  • iml
  • DALEX

IML

关于iml包进行模型解释有专门一本书:IML Book。
这里简单介绍。

企鹅任务

企鹅数据包括8个变量,344个企鹅(344行)。

data("penguins", package = "palmerpenguins")
str(penguins)
## tibble [344 x 8] (S3: tbl_df/tbl/data.frame)
## $ species : Factor w/ 3 levels "Adelie","Chinstrap",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ island : Factor w/ 3 levels "Biscoe","Dream",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ bill_length_mm : num [1:344] 39.1 39.5 40.3 NA 36.7 39.3 38.9 39.2 34.1 42 ...
## $ bill_depth_mm : num [1:344] 18.7 17.4 18 NA 19.3 20.6 17.8 19.6 18.1 20.2 ...
## $ flipper_length_mm: int [1:344] 181 186 195 NA 193 190 181 195 193 190 ...
## $ body_mass_g : int [1:344] 3750 3800 3250 NA 3450 3650 3625 4675 3475 4250 ...
## $ sex : Factor w/ 2 levels "female","male": 2 1 1 NA 1 2 1 2 NA NA ...
## $ year : int [1:344] 2007 2007 2007 2007 2007 2007 2007 2007 2007 2007 ...

创建任务:

library(iml)
library(mlr3)
library(mlr3learners)

set.seed(1)
penguins <- na.omit(penguins)
task_peng <- as_task_classif(penguins, target = "species")

选择模型并训练,提取模型:

learner <- lrn("classif.ranger", predict_type = "prob")
learner$train(task_peng)
learner$model
## Ranger result
##
## Call:
## ranger::ranger(dependent.variable.name = task$target_names, data = task$data(), probability = self$predict_type == "prob", case.weights = task$weights$weight, num.threads = 1L)
##
## Type: Probability estimation
## Number of trees: 500
## Sample size: 333
## Number of independent variables: 7
## Mtry: 2
## Target node size: 10
## Variable importance mode: none
## Splitrule: gini
## OOB prediction error (Brier s.): 0.01790106
x <- penguins[which(names(penguins) != "species")]
model <- Predictor$new(learner, data = x, y = penguins$species)

FeatureEffects

num_features <- c("bill_length_mm", "bill_depth_mm", "flipper_length_mm", "body_mass_g", "year")
effect <- FeatureEffects$new(model)
plot(effect, features = num_features)

plot of chunk unnamed-chunk-5

Shapley

x <- penguins[which(names(penguins) != "species")]
model <- Predictor$new(learner, data = penguins, y = "species")
x.interest <- data.frame(penguins[1, ])
shapley <- Shapley$new(model, x.interest = x.interest)
plot(shapley)

plot of chunk unnamed-chunk-6

Featurelmp

effect <- FeatureImp$new(model, loss = "ce")
effect$plot(features = num_features)

plot of chunk unnamed-chunk-7

独立测试数据

split <- partition(task_peng, ratio = 0.8)
train_set <- split$train
test_set <- split$test

learner$train(task_peng, row_ids = train_set)
prediction <- learner$predict(task_peng, row_ids = test_set)
# 训练集
model <- Predictor$new(learner, data = penguins[train_set, ], y = "species")
effect <- FeatureImp$new(model, loss = "ce")
plot_train <- plot(effect, features = num_features)

# 测试集
model <- Predictor$new(learner, data = penguins[test_set, ], y = "species")
effect <- FeatureImp$new(model, loss = "ce")
plot_test <- plot(effect, features = num_features)

# 放到一起
library("patchwork")
plot_train + plot_test

plot of chunk unnamed-chunk-9

分别查看feasurelmp

model <- Predictor$new(learner, data = penguins[train_set, ], y = "species")
effect <- FeatureEffects$new(model)
plot(effect, features = num_features)

plot of chunk unnamed-chunk-10

model <- Predictor$new(learner, data = penguins[test_set, ], y = "species")
effect <- FeatureEffects$new(model)
plot(effect, features = num_features)

plot of chunk unnamed-chunk-11

DALEX

这个包介绍的方法也有一本书:Explanatory Model Analysis。

DALEX包可透视预测模型,帮助我们探索、解释、可视化模型行为。将使用fifa20数据集进行演示。

这个包干的事情可通过下图理解:

读取数据

library(DALEX)
## Welcome to DALEX (version: 2.3.0).
## Find examples and detailed introduction at: http://ema.drwhy.ai/
## 
## 载入程辑包:'DALEX'
## The following object is masked from 'package:generics':
##
## explain
## The following object is masked from 'package:dplyr':
##
## explain
data(fifa, package = "DALEX")
fifa[1:2, c("value_eur", "age", "height_cm", "nationality", "attacking_crossing")]
##                   value_eur age height_cm nationality attacking_crossing
## L. Messi 95500000 32 170 Argentina 88
## Cristiano Ronaldo 58500000 34 187 Portugal 84

对于每个球员,都有42个feature,

dim(fifa)
## [1] 5000   42

进行简单的处理,有助于我们理解:

fifa[, c("nationality", "overall", "potential", "wage_eur")] = NULL
for (i in 1:ncol(fifa)) fifa[, i] = as.numeric(fifa[, i])

建模

library(mlr3)
library(mlr3learners)

fifa_task <- as_task_regr(fifa, target = "value_eur")

fifa_ranger <- lrn("regr.ranger", num.trees = 250)
fifa_ranger$train(fifa_task)
fifa_ranger
## <LearnerRegrRanger:regr.ranger>
## * Model: ranger
## * Parameters: num.threads=1, num.trees=250
## * Packages: mlr3, mlr3learners, ranger
## * Predict Type: response
## * Feature types: logical, integer, numeric, character, factor, ordered
## * Properties: hotstart_backward, importance, oob_error, weights

DALEX工作的一般流程

model %>%
  explain_mlr3(data = ..., y = ..., label = ...) %>%
  model_parts() %>%
  plot()
library("DALEX")
library("DALEXtra")
## Anaconda not found on your computer. Conda related functionality such as create_env.R and condaenv and yml parameters from explain_scikitlearn will not be available
ranger_exp <- explain_mlr3(fifa_ranger,
                           data = fifa,
                           y = fifa$value_eur,
                           label = "Ranger RF",
                           colorize = FALSE)
## Preparation of a new explainer is initiated
## -> model label : Ranger RF
## -> data : 5000 rows 38 cols
## -> target variable : 5000 values
## -> predict function : yhat.LearnerRegr will be used ( default )
## -> predicted values : No value for predict function target column. ( default )
## -> model_info : package mlr3 , ver. 0.13.2.9000 , task regression ( default )
## -> predicted values : numerical, min = 509536.7 , mean = 7472248 , max = 92074300
## -> residual function : difference between y and yhat ( default )
## -> residuals : numerical, min = -8364287 , mean = 1039.203 , max = 17510200
## A new explainer has been created!

数据集水平的探索

fifa_vi <- model_parts(ranger_exp)
head(fifa_vi)
##              variable mean_dropout_loss     label
## 1 _full_model_ 1339676 Ranger RF
## 2 value_eur 1339676 Ranger RF
## 3 weight_kg 1400918 Ranger RF
## 4 movement_balance 1402226 Ranger RF
## 5 goalkeeping_kicking 1405259 Ranger RF
## 6 height_cm 1409160 Ranger RF
plot(fifa_vi, max_vars = 12, show_boxplots = F)

plot of chunk unnamed-chunk-19

selected_variables <- c("age", "movement_reactions",
  "skill_ball_control", "skill_dribbling")

fifa_pd <- model_profile(ranger_exp,
                         variables = selected_variables)$agr_profiles
fifa_pd
## Top profiles    : 
## _vname_ _label_ _x_ _yhat_ _ids_
## 1 skill_ball_control Ranger RF 5 7535469 0
## 2 skill_dribbling Ranger RF 7 7911763 0
## 3 skill_dribbling Ranger RF 11 7904604 0
## 4 skill_dribbling Ranger RF 12 7903967 0
## 5 skill_dribbling Ranger RF 13 7902823 0
## 6 skill_dribbling Ranger RF 14 7901248 0
library("ggplot2")
plot(fifa_pd) +
  scale_y_continuous("Estimated value in Euro", labels = scales::dollar_format(suffix = "€", prefix = "")) +
  ggtitle("Partial Dependence profiles for selected variables")

plot of chunk unnamed-chunk-21

instance水平的探索

ronaldo <- fifa["Cristiano Ronaldo", ]
ronaldo_bd_ranger <- predict_parts(ranger_exp,
                                   new_observation = ronaldo)
head(ronaldo_bd_ranger)
##                                         contribution
## Ranger RF: intercept 7472248
## Ranger RF: movement_reactions = 96 11845999
## Ranger RF: skill_ball_control = 92 7170577
## Ranger RF: mentality_positioning = 95 4565939
## Ranger RF: attacking_finishing = 94 4874197
## Ranger RF: attacking_short_passing = 83 4279799
plot(ronaldo_bd_ranger)

plot of chunk unnamed-chunk-23

ronaldo_shap_ranger <- predict_parts(ranger_exp,
                                     new_observation = ronaldo,
                                     type = "shap")

plot(ronaldo_shap_ranger) +
  scale_y_continuous("Estimated value in Euro", labels = scales::dollar_format(suffix = "€", prefix = ""))

plot of chunk unnamed-chunk-24

selected_variables <- c("age", "movement_reactions",
  "skill_ball_control", "skill_dribbling")

ronaldo_cp_ranger <- predict_profile(ranger_exp, ronaldo, variables = selected_variables)

plot(ronaldo_cp_ranger, variables = selected_variables) +
  scale_y_continuous("Estimated value of Christiano Ronaldo", labels = scales::dollar_format(suffix = "€", prefix = ""))

plot of chunk unnamed-chunk-25

举报

相关推荐

0 条评论