在R中绘制ROC曲线而不使用任何包

Question

嗨，我对R中的编程很陌生，而且我在不使用任何软件包的情况下绘制了ROC曲线。

我使用以下方式生成数据：

d=rpearsonIII(100,0.5,360,20)
nd=rnorm(100,450,25)

我需要一个值为＆lt; 400且d为＆gt; 400的向量，所以我做了：

spec = (cumsum(nd[nd>400])/sum(nd))*100
sens = (cumsum(d[d<400])/sum(nd))*100

和我的绘图如下：

plot(1-spec,sens)

但情节并不像我预期的那样

编辑： 感谢给出的建议我的代码现在看起来像这样：

sc2 = c(rnorm(50,450,25),rpearsonIII(50,0.5,360,20))
scF = sc2 < 395

thresholds <- sort(sc2)

pos <- sum(scF);pos
neg <- sum(!scF);neg

tn <- cumsum(!scF);tn
spec <- tn/neg;spec

tp <- pos - cumsum(scF);tp
sens <- tp/pos;sens

plot(1 - spec, sens, type = "l", col = "red", 
     ylab = "Sensitivity", xlab = "1 - Specificity")
abline(c(0,0),c(1,1))

绘制的roc曲线如下所示： roc curve

我现在的问题是，如果更改生成数据的顺序（rnorm和rpearsonIII），则曲线会反转。

Answer 1

我不知道rpearsonIII是什么，所以我只想制作一个包含实际班级actuals的随机数据样本以及预测分数scores

set.seed(100)
actuals <- sample(c(TRUE,FALSE), 100, replace = TRUE)
scores <- runif(100,-1,1)

带有说明

的长版本

如果您的数据中的实际值是字符串或因子而不是逻辑，则需要使用以下命令将它们转换为逻辑：

actuals <- actuals == "postiveClass"

接下来，我们要根据分数对实例进行排序。我们可以这样做：

actuals <- actuals[order(scores)]

如果您想跟踪敏感度和特异性的阈值，可以使用以下方法保持对齐：

thresholds <- sort(scores)

现在我们需要了解我们的敏感性和特殊性。敏感度为TP/P，特异性为TN/N。获得积极的总数P很容易，因为我们的实际情况是合乎逻辑的，我们可以使用sum(actuals)。相似性，我们可以使用N获得否定sum(!actuals)。

pos <- sum(actuals)
neg <- sum(!actuals)

首先让我们在每个门槛上得到真正的否定。这很简单，只是每个阈值等于或低于FALSE值的数量。由于我们的数据按阈值排序，我们可以使用以下方法计算（和特异性）：

tn <- cumsum(!actuals)
spec <- tn/neg

真阳性的数量稍微难一些，因为我们正在寻找阈值的阳性更多的数量，因此单独cumsum无法工作。但是，由于高于阈值的数字等于低于或低于阈值的总数，我们可以使用以下方式获得真正的正数：

tp <- pos - cumsum(actuals)
sens <- tp/pos

现在我们需要做的就是绘制两个。

plot(1 - spec, sens, type = "l", col = "red", 
     ylab = "Sensitivity", xlab = "1 - Specificity")
abline(c(0,0),c(1,1))

要获得曲线的AUC，我们只需要计算曲线的高度（灵敏度）乘以每个实际值的宽度（1 - 特异性的差异）。我们已经具有敏感性，我们只需要特异性。 diff函数将为我们提供相邻特异性值的差异，但是，我们需要在开头添加0值以获得第一列的宽度。

width <- diff(c(0, 1 - sens))
auc <- sum(spec*width)

最小代码版本

actuals <- actuals[order(scores)]

sens <- (sum(actuals) - cumsum(actuals))/sum(actuals)
spec <- cumsum(!actuals)/sum(!actuals)

plot(1 - spec, sens, type = "l", col = "red", 
     ylab = "Sensitivity", xlab = "1 - Specificity")
abline(c(0,0),c(1,1))

(auc <- sum(spec*diff(c(0, 1 - sens))))