我有150列得分和1列标签(1/0)。
我的目标是创建150个AUC得分。
以下是一个手动示例:
auc(roc(df$label, df$col1)),
auc(roc(df$label, df$col2)),
...
我可以使用Map / sapply / lapply,但是否有其他方法或函数?
library(pROC)
's roc
/auc
functions, you can gain even more speed by selecting the appropriate algorithm for your dataset.
pROC
comes with essentially two algorithms that scale very differently depending on the characteristics of your data set. You can benchmark which one is the fastest by passing algorithm=0
to roc
:# generate some toy data
label <- rbinom(600000, 1, 0.5)
score <- rpois(600000, 10)
library(pROC)
roc(label, score, algorithm=0)
Starting benchmark of algorithms 2 and 3, 10 iterations...
expr min lq mean median uq max neval
2 2 4805.58762 5827.75410 5910.40251 6036.52975 6085.8416 6620.733 10
3 3 98.46237 99.05378 99.52434 99.12077 100.0773 101.363 10
Selecting algorithm 3.
auc(roc(df$label, df$col1, algorithm=2)),
auc(roc(df$label, df$col2, algorithm=2)),
roc
现在大约需要5秒钟,与阈值的数量相对独立。这样你应该在不到15分钟内完成。除非你有50个或更多核心,否则这比仅仅并行化要快。但当然你也可以两者都做...如果您想并行计算,可以按如下方式进行:
# generate some toy data
label <- rbinom(1000, 1, .5)
scores <- matrix(runif(1000*150), ncol = 150)
df <- data.frame(label, scores)
library(pROC)
library(parallel)
auc(roc(df$label, df$X1))
#> Area under the curve: 0.5103
auc_res <- mclapply(df[,2:ncol(df)], function(row){auc(roc(df$label, row))})
head(auc_res)
#> $X1
#> Area under the curve: 0.5103
#>
#> $X2
#> Area under the curve: 0.5235
#>
#> $X3
#> Area under the curve: 0.5181
#>
#> $X4
#> Area under the curve: 0.5119
#>
#> $X5
#> Area under the curve: 0.5083
#>
#> $X6
#> Area under the curve: 0.5159
由于大部分的计算时间似乎都是针对auc(roc(...))
的调用,如果你有一台多核机器,那么这应该可以加速处理。
parSapply
。为什么你使用了mclapply
?@gfgm - stevesparSapply()/parLapply()
的示例,因为mcapply
不兼容Windows(这是我没有考虑到的)@steves - gfgm在cutpointr
包中有一个函数可以实现这个功能。它还会计算截断点和其他指标,但是您可以将其丢弃。默认情况下,它将尝试除响应列以外的所有列作为预测变量。此外,您可以通过省略direction
或手动设置来选择ROC曲线的方向(较大的值是否意味着正类或相反)。
dat <- iris[1:100, ]
library(tidyverse)
library(cutpointr)
mc <- multi_cutpointr(data = dat, class = "Species", pos_class = "versicolor",
silent = FALSE)
mc %>% select(variable, direction, AUC)
# A tibble: 4 x 3
variable direction AUC
<chr> <chr> <dbl>
1 Sepal.Length >= 0.933
2 Sepal.Width <= 0.925
3 Petal.Length >= 1.00
4 Petal.Width >= 1.00
cutpointr
或ROCR
计算ROC曲线(甚至包括切点)对于一个变量和一百万个观测值只需要不到一秒钟的时间,所以您的任务大约需要一到两分钟才能完成。map
时立即选择感兴趣的列。# 600.000 observations for 150 variables and a binary outcome
predictors <- matrix(data = rnorm(150 * 6e5), ncol = 150)
dat <- as.data.frame(cbind(y = sample(0:1, size = 6e5, replace = T), predictors))
library(cutpointr)
library(tidyverse)
vars <- colnames(dat)[colnames(dat) != "y"]
result <- map_df(vars, function(coln) {
cutpointr_(dat, x = coln, class = "y", silent = TRUE, pos_class = 1) %>%
select(direction, AUC) %>%
mutate(variable = coln)
})
result
# A tibble: 150 x 3
direction AUC variable
<chr> <dbl> <chr>
1 >= 0.500 V2
2 <= 0.501 V3
3 >= 0.501 V4
4 >= 0.501 V5
5 <= 0.501 V6
6 <= 0.500 V7
7 <= 0.500 V8
8 >= 0.502 V9
9 >= 0.501 V10
10 <= 0.500 V11
# ... with 140 more rows
apply
家族函数有什么问题吗?在我看来,purrr
包做类似的事情但更加直观。但是,它与apply
家族函数相似。你的最终目标是什么,是一个包含所有分数的数据框吗? - Amardplyr
中,你可以这样做:1. 使用gather()
收集所有的col1, col2, ...
分数 2. 对分数进行group_by()
操作 3. 使用summarise()
获得 AUC。 - Mariusroc()
/auc()
中,而不受你用来循环/迭代的方法影响,但也有可能会有一些差异。 - Marius