在 R 中创建许多 ROC 曲线？

Question

我有 150 列分数对应 1 列标签 (1/0)。我的目标是创造 150 个 AUC 分数。

这是一个手动示例：

auc(roc(df$label, df$col1)),
auc(roc(df$label, df$col2)),

...

我可以在这里使用Map/sapply/lapply但是有没有其他方法或功能？

Answer 1

如果你想并行化计算，你可以这样做：

# 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(...)) 的调用，如果您有多核机器，这应该会加快速度。

Answer 2

cutpointr 包中有一个函数可以做到这一点。它还会计算分界点和其他指标，但您可以丢弃它们。默认情况下，它将尝试除响应列之外的所有列作为预测变量。此外，您可以 select 是否通过省略 direction 或手动设置自动确定 ROC 曲线的方向（较大的值表示正 class 还是相反）。

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，因此您的任务大约会在一两分钟内运行。

如果内存是限制因素，并行化可能会使问题变得更糟。如果上述解决方案占用太多内存，因为它在删除这些列之前对所有变量进行 returns ROC 曲线，您可以尝试 select 在调用 [=16 时立即对感兴趣的列进行 select =]:

# 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

Answer 3

这有点像 XY question. What you actually want to achieve is speed up your calculation. 用并行化来回答它，但这只是一种方法。

如果像我假设的那样，您正在使用 library(pROC) 的 roc/auc 函数，您可以通过 select 适当的算法获得更快的速度为您的数据集。

pROC 本质上带有两种算法，根据数据集的特征，它们的缩放比例非常不同。您可以通过将 algorithm=0 传递给 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.

这里我们 select 算法 3，当阈值数量保持较低时，它会发光。但是，如果 600000 个数据点需要 5 分钟来计算，我强烈怀疑您的数据是非常连续的（没有具有相同值的测量值）并且您的阈值与数据点（600000）一样多。在这种情况下，您可以直接跳到算法 2，它随着 ROC 曲线中阈值数量的增加而扩展得更好。

然后您可以运行:

auc(roc(df$label, df$col1, algorithm=2)),
auc(roc(df$label, df$col2, algorithm=2)),

在我的机器上，每次调用 roc 现在大约需要 5 秒，与阈值的数量完全无关。这样你总共应该在 15 分钟内完成。除非你有 50 个或更多的内核，否则这将比仅仅并行化更快。但是当然你可以两者都做...

在 R 中创建许多 ROC 曲线？

Create many ROC curves in R?

r

roc