【R语言】单个分类模型性能评估、两个分类模型性能对比、统计检验

 单个模型评估

# install.packages("pROC")
library(pROC)

calculate_metrics <- function(label, prediction) {
  # 加载所需的包
  library(pROC)
  
  # 计算ROC曲线和AUC
  roc_obj <- roc(label, prediction)
  auc_value <- auc(roc_obj)
  
  # 寻找最佳cutoff
  cutoff <- coords(roc_obj, "best", ret = "threshold")
  
  # 根据cutoff计算混淆矩阵
  predicted_label <- ifelse(prediction >= cutoff$threshold, 1, 0)
  confusion_matrix <- table(predicted_label, label)
  
  # 提取混淆矩阵中的TP,TN,FP和FN
  TP <- confusion_matrix[2, 2]
  TN <- confusion_matrix[1, 1]
  FP <- confusion_matrix[2, 1]
  FN <- confusion_matrix[1, 2]
  
  # 计算敏感度和特异度
  sensitivity <- TP / (TP + FN)
  specificity <- TN / (TN + FP)
  
  # 返回结果
  result <- list(
    AUC = auc_value,
    Cutoff = cutoff$threshold,
    Confusion_Matrix = confusion_matrix,
    TP = TP,
    TN = TN,
    FP = FP,
    FN = FN,
    Sensitivity = sensitivity,
    Specificity = specificity
  )
  
  return(result)
}

# 使用示例数据调用函数
set.seed(123)
label <- sample(0:1, 100, replace = TRUE)
pred <- runif(100)
metrics <- calculate_metrics(label, pred)
print(metrics)

多个模型对比分析及统计检验

# install.packages("pROC")
library(pROC)
compare_models <- function(label, pred1, pred2) {
  # 加载所需的包
  library(pROC)
  
  # 计算ROC曲线
  roc1 <- roc(label, pred1)
  roc2 <- roc(label, pred2)
  
  # Delong检验
  delong_test_result <- roc.test(roc1, roc2, method = "delong")
  
  # 寻找最佳阈值
  cutoff1 <- coords(roc1, "best", ret = "threshold")
  cutoff2 <- coords(roc2, "best", ret = "threshold")
  
  # 计算敏感度和特异度
  predicted_label1 <- ifelse(pred1 >= cutoff1$threshold, 1, 0)
  predicted_label2 <- ifelse(pred2 >= cutoff2$threshold, 1, 0)
  
  sensitivity1 <- sum(predicted_label1 == 1 & label == 1) / sum(label == 1)
  sensitivity2 <- sum(predicted_label2 == 1 & label == 1) / sum(label == 1)
  
  specificity1 <- sum(predicted_label1 == 0 & label == 0) / sum(label == 0)
  specificity2 <- sum(predicted_label2 == 0 & label == 0) / sum(label == 0)
  
  # 比例检验
  sensitivity_test <- prop.test(
    x = c(sum(predicted_label1 == 1 & label == 1), sum(predicted_label2 == 1 & label == 1)),
    n = c(sum(label == 1), sum(label == 1)),
    correct = FALSE
  )
  
  specificity_test <- prop.test(
    x = c(sum(predicted_label1 == 0 & label == 0), sum(predicted_label2 == 0 & label == 0)),
    n = c(sum(label == 0), sum(label == 0)),
    correct = FALSE
  )
  
  # 返回结果
  result <- list(
    Delong_Test_Result = delong_test_result,
    Sensitivity_Test_Result = sensitivity_test,
    Specificity_Test_Result = specificity_test,
    Sensitivity1 = sensitivity1,
    Sensitivity2 = sensitivity2,
    Specificity1 = specificity1,
    Specificity2 = specificity2,
    Cutoff1 = cutoff1$threshold,
    Cutoff2 = cutoff2$threshold
  )
  
  return(result)
}

# 使用示例数据调用函数
set.seed(123)
label <- sample(0:1, 100, replace = TRUE)
pred1 <- runif(100)
pred2 <- runif(100)

comparison_result <- compare_models(label, pred1, pred2)
print(comparison_result)

  • 4
    点赞
  • 2
    收藏
    觉得还不错? 一键收藏
  • 3
    评论
评论 3
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值