时间戳

首页 > 解决方案 > imap_dfr 3 个带有嵌套地图的列表的函数？

r - imap_dfr 3 个带有嵌套地图的列表的函数？

问题描述

我有这段代码适用于 list[[1]]和 list of list [[200]]：

SHAP_Prep_data <- shap.prep(xgb_model = xgb.mod[[1]][[200]],
                            shap_contrib = shap_values_results[[1]][[200]]$shap_score %>% select(-BIAS0),
                            X_train = as.matrix(TrainTestData[[1]]$XTrain[[200]])
                            #top_n = 4
)

我可以简单地替换掉[[200]]for[[300]]等[[400]]，并获得一个新的数据结构（shap.prep函数来自shapforxgboost包。

xgb.mod[[1]][[200]]是单个 xgboost 模型

shap_values_results[[1]][[200]]$shap_score %>% select(-BIAS0)是具有以下结构的数据框。

> str(shap_values_results[[1]][[200]]$shap_score %>% select(-BIAS0))
'data.frame':   2190 obs. of  29 variables:
 $ holiday              : num  -0.276 -0.347 -0.284 -0.356 -0.197 ...
 $ temp                 : num  0.35 0.25 0.144 0.227 0.16 ...
 $ wind                 : num  -0.116 -0.187 -0.25 -0.265 -0.135 ...
 $ humidity             : num  -0.021 0.0125 -0.037 0.016 -0.0196 ...
 $ barometer            : num  -0.0191742 -0.0000462 0.0444956 -0.0148842 -0.0551703 ...
 $ weekday              : num  -0.00421 -0.00937 0.0012 -0.01194 -0.00931 ...
 $ weekend              : num  0 0 0 0 0 0 0 0 0 0 ...
 $ workday_on_holiday   : num  -0.00949 -0.00949 -0.00885 -0.00949 -0.00885 ...
 $ weekend_on_holiday   : num  0 0 0 0 0 0 0 0 0 0 ...
 $ protocol_active      : num  0 0 0 0 0 0 0 0 0 0 ...
 $ text_fog             : num  0.00714 0.00714 0.00783 0.00783 0.00772 ...
 $ text_light_rain      : num  -0.000364 -0.000364 -0.000364 -0.000364 -0.000364 ...
 $ text_mostly_cloudy   : num  -0.0013 -0.0013 -0.0013 -0.0013 -0.0013 ...
 $ text_passing_clouds  : num  0.00135 0.00152 0.00363 0.00152 0.00345 ...
 $ text_rain            : num  -0.0000682 -0.0000682 -0.0000682 -0.0000682 -0.0000682 ...
 $ text_scattered_clouds: num  -0.0941 -0.0832 -0.1497 -0.0813 -0.0965 ...
 $ text_sunny           : num  0.000635 0.007435 0.009286 0.007435 0.007009 ...
 $ month_1              : num  0.045 0.0503 0.062 0.062 0.0484 ...
 $ month_2              : num  0.0602 0.0529 0.0526 0.0529 0.1008 ...
 $ month_3              : num  0.0467 0.0348 0.0333 0.0348 0.0467 ...
 $ month_4              : num  -0.03439 -0.03439 -0.00777 -0.03439 -0.00164 ...
 $ month_5              : num  -0.02191 -0.02191 -0.00836 -0.02026 -0.01533 ...
 $ month_6              : num  -0.05498 -0.00637 -0.04769 -0.05101 -0.05155 ...
 $ month_7              : num  -0.1302 -0.1126 -0.0878 -0.0963 -0.1535 ...
 $ month_8              : num  -0.0418 -0.051 -0.0727 -0.0437 -0.0957 ...
 $ month_9              : num  0.164 0.185 0.141 0.193 0.122 ...
 $ month_10             : num  0.206 0.251 0.243 0.251 0.211 ...
 $ month_11             : num  0.0929 0.0744 0.0302 0.0568 0.0961 ...
 $ month_12             : num  0.059 0.0608 0.0806 0.0608 0.0788 ...

最后as.matrix(TrainTestData[[1]]$XTrain[[200]])是一个 dgcMatrix，我使用它转换为一个简单的矩阵，as.matrix()它具有以下结构：

> str(as.matrix(TrainTestData[[1]]$XTrain[[200]]))
 num [1:2190, 1:29] 0 0 0 0 0 0 0 0 0 0 ...
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr [1:29] "holiday" "temp" "wind" "humidity" ...

我有 3 条数据要应用该shap.prep函数。

所需的输出将是一个列表（或列表列表），其中shap.prep应用了该函数。该功能需要 3 个输入shap.prep(xgb_model = NULL, shap_contrib = NULL, X_train, top_n = NULL)，这就是我提供的。

如何imap正确使用将所有三个对象传递给shap_prep函数并获取列表作为我的输出？

我很难提供一些dput()数据，因为我不确定它是否可以用于dput()经过训练的 XGBoost 模型。

编辑：

我正在添加最接近可重现示例的内容。

data(iris)
df <- split(iris, iris$Species) # I just want to create some lists here

library(xgboost)
library(SHAPforxgboost)

dtrainFunction <- function(i){
  dt = xgb.DMatrix(data = data.matrix(i[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]), label = i$Species)
}

dtrain <- map(df, dtrainFunction)   # I just apply the dtrainFunction which just puts each list into an xgb.DMatrix

xgb.mod <- map(dtrain, ~xgboost(data = .x, nround = 20))  # Apply the xgboost model to each list

# could not get this part of the code to work but it's not important. I manually put the results into a list below.
# shap_values_function <- function(j){
#   map2(
#     .x = xgb.mod[[j]],
#     .y = df[[j]][, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")],
#     ~shap.values(xgb_model = .x, X_train = as.matrix(.y))
#   )
# }
# 
# shap_values_results <- lapply(seq(1:3), shap_values_function)

# Here I manually put the results into a list which are lists of shap.values
shap_values_results <- list(
  shap.values(xgb_model = xgb.mod[[1]], X_train = as.matrix(df[[1]][, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")])),
  shap.values(xgb_model = xgb.mod[[2]], X_train = as.matrix(df[[2]][, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")])),
  shap.values(xgb_model = xgb.mod[[3]], X_train = as.matrix(df[[3]][, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]))
)

# Something is wrong here which is something to do with shap_contrib and BIAS0
SHAP_Prep_data <- shap.prep(xgb_model = xgb.mod[[1]],
                            shap_contrib = shap_values_results[[1]]$shap_score[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")],
                            X_train = as.matrix(df[[1]])
                            #top_n = 4
)

shap.plot.summary(data_long = SHAP_Prep_data)

SHAP_Prep_data由于我有列表列表，因此我的数据实际代码与上面的代码略有不同。

编辑2：

我尝试了以下引发错误的方法：

SHAP_Prep_data <- pmap(
  list(
    .x = xgb.model[[1]],
    .y = shap_values_results[[1]],
    .z = TrainTestData[[1]]$XTrain
    ), ~shap.prep(
      xgb_model = .x,
      shap_contrib = .y,
      X_train = as.matrix(.z))
)

as.matrix(.z) 中的错误：找不到对象“.z”

编辑3：当我在虹膜数据示例上应用该函数时：

SHAP_Prep_data <- pmap(
  list(
    .x = xgb.mod,
    .y = shap_values_results,
    .z = dtrain
  ), ~shap.prep(
    xgb_model = .x,
    shap_contrib = .y,
    X_train = as.matrix(.z))
)

as.matrix(.z) 中的错误：找不到对象“.z”

编辑4：

我希望能够访问$shap_score从之前使用的函数创建的数据shap.values（并BIAS0从下一行删除数据中的列）。

shap_contrib = shap_values_results[[1]][[1300]]$shap_score %>% select(-BIAS0)

那么map这里还需要另一个吗？shap_score或者我应该在函数的早期提取数据并删除那里的BIAS0列，以便我可以调用NEWDATA_shap_score[[1]][[1300]]？

标签： rpurrr

解决方案

问题是

str(as.matrix(df[[1]]))
#chr [1:50, 1:5] "5.1" "4.9" "4.7" "4.6" "5.0" "5.4" "4.6" "5.0" "4.4" "4.9" "5.4" "4.8" "4.8" "4.3" "5.8" "5.7" "5.4" "5.1" "5.7" "5.1" ...
# - attr(*, "dimnames")=List of 2
#  ..$ : chr [1:50] "1" "2" "3" "4" ...
#  ..$ : chr [1:5] "Sepal.Length" "Sepal.Width" "Petal.Length" "Petal.Width" ...

返回一个character矩阵，因为最后一列是一character列。删除最后一列，然后进行转换

out <- shap.prep(xgb_model = xgb.mod[[1]],
                        shap_contrib = shap_values_results[[1]]$shap_score[, 
                 c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")],
                         X_train = as.matrix(df[[1]][-5])  ###
                         #top_n = 4
  )

关于使用这个pmap

out2 <- pmap(list( xgb.model[[1]],
           shap_values_results[[1]],
           TrainTestData[[1]]$XTrain),
         ~shap.prep(
  xgb_model = ..1,
  shap_contrib = ..2$shap_score %>% select(-BIAS0),
  X_train = as.matrix(..3)))

如果我们也想在listslist上应用这个

 pmap(list(xgb.model,
           shap_values_results,
           TrainTestData), ~ 

           pmap(list(..1, ..2, ..3$xTrain), ~
             shap.prep(xgb_model = ..1,
                       shap_contrib = ..2$shap_score %>% select(-BIAS0),
                       X_train = as.matrix(..3))))

推荐阅读