感度100%、PPV●%のアウトカム定義を用いて発現割合を補正する

確認したいこと

• 感度100%の定義があれば、その定義を用いて算出された発現割合に対してPPVをかけてあげれば正しい発現割合に補正できるか。
• 信頼区間はブートストラップで推定できるのではないか。

Rコード

# toy data prep
N <- 100
Y <- rbinom(N, size = 1, prob = 0.3) # 真のアウトカム
A <- Y + (1-Y)*sample(c(0,1), size = N, replace = T) # アウトカム定義
d <- data.frame(A,Y) 

# 2by2 table
(twobytwo <- table(def = A,true = Y)[c(2,1),c(2,1)])

# Estimates
## ここら辺は過去記事書く時のものを流用
sens_ppv_spec <-
  function(mat) {
    
    sens <- mat[1,1]/sum(mat[,1])
    ppv <- mat[1,1]/sum(mat[1,])
    spec <- mat[2,2]/sum(mat[,2])
    
    return(c(sens = sens, ppv = ppv, spec = spec))
    
  }

> sens_ppv_spec(twobytwo)
     sens       ppv      spec 
1.0000000 0.5151515 0.5151515 

# bootstrap CI for calibrated incidence proportion
resampling <-
function(.data){
  
  # resampling
  indices <- sample(1:nrow(.data), replace = T)
  bootsample <- .data[indices,]
  
  # calculate ppv and others
  twobytwo <- table(def = bootsample$A,true = bootsample$Y)[c(2,1),c(2,1)]
  bootest <- sens_ppv_spec(twobytwo)
  
  # get crude proportion and calibrated one using ppv
  crude_prop <- sum(bootsample$A==1)/nrow(bootsample)
  calibrated_prop <- crude_prop*unname(bootest['ppv'])
  
  return(c(crude=crude_prop, 
           calibrated=calibrated_prop))
}

結果

n=100のブートストラップサンプルでのアウトカムの割合とそのパーセンタイルベースの95%信頼区間を出す。

> iter <- 100
> 
> apply(
+   replicate(iter, resampling(d)),
+       1,
+       function(x) c(mean = mean(x), 
+                     quantile(x,probs = 0.025), 
+                     quantile(x,probs = 0.975)
+                     )
+ )
        crude calibrated
mean  0.66220    0.33980
2.5%  0.55475    0.23475
97.5% 0.76000    0.44525

点推定値・信頼区間ともに、真のアウトカム定義を利用した場合と同等であった。

> binom.test(x=sum(d$Y==1),n=sum(twobytwo))$est
probability of success 
                  0.34 
> binom.test(x=sum(d$Y==1),n=sum(twobytwo))$conf.int[c(1,2)]
[1] 0.2482235 0.4415333