决策曲线分析（DCA）中平均净阈值用于评价模型算法（R自定义函数）

news2024/12/12 20:08:01

决策曲线分析（DCA）中平均净阈值用于评价模型算法

DCA分析虽然不强调用来评价模型算法或者变量组合的优劣，但是实际应用过程中感觉DCA曲线的走势和模型的效能具有良好的一致性，其实这种一致性也可以找到内在的联系，比如通过净阈值的计算公式可以知道净阈值的大小与真阳性率有密切的关系，而真阳性率和模型的效能也有一致性。

如果想用DCA曲线来挑选算法或者变量组合，有一个定量的指标就更加方便一些，这就有了为DCA曲线找一个定量指标的想法。

1. 微积分法

曲线下面积可能是比较直观的一种方法，首先想到的是用微积分的方法计算DCA曲线下面积，代码如下。因为对微积分并不熟悉，加上计算出的结果还会有负值的情况，所以不是太确定代码的正确性，大家谨慎采用。

WA_NBC <- function(df, pred, real, integration_limits = c(0, 1), prevalence) {
  # 内部函数计算净获益
  calculate_nbc <- function(pt) {
    # NBC函数的代码
    tp <- sum(df[[pred]] >= pt & df[[real]] == 1)
    fp <- sum(df[[pred]] >= pt & df[[real]] == 0)
    net_benefit <- tp/nrow(df) - fp/nrow(df) * pt/(1-pt)
    if (!is.null(prevalence)) {
      net_benefit <- net_benefit / prevalence
    }
    return(net_benefit)
  }

  # 计算加权平均净获益
  integrand <- function(x) {
    calculate_nbc(x)
  }
  integral_result <- stats::integrate(integrand, lower = integration_limits[1], upper = integration_limits[2])
  wa_nbc <- integral_result$value / diff(integration_limits)

  return(wa_nbc)
}

2. 净收益平均法

这种方法是计算指定阈值范围内的净阈值然后求平均。感觉更好理解一些，但是似乎技术含量低些。

library(purrr)

mean_benefit <- function(df, pred, real, integration_limits = c(0, 1), prevalence) {
    calculate_nbc <- function(pt) {
    # NBC函数的代码
    tp <- sum(df[[pred]] >= pt & df[[real]] == 1)
    fp <- sum(df[[pred]] >= pt & df[[real]] == 0)
    net_benefit <- tp/nrow(df) - fp/nrow(df) * pt/(1-pt)
    if (!is.null(prevalence)) {
      net_benefit <- net_benefit / prevalence
    }
    return(net_benefit)
  }

  # 使用map_dbl对每个阈值计算净获益
  net_benefits <- map_dbl(seq(integration_limits[1], integration_limits[2], by = 0.01), 
                          ~ calculate_nbc(.x))
  # 计算加权平均净获益
  mean(net_benefits)
}