# Functions used to help calculate accuracy measures after the data simulation
# This program is used by other programs for Section 5
# These functions were written by Peng Chen for Bilder, Tebbs, and Chen (JASA, 2010)
# purpose: compute negative predictive value
npv <- function(g, Y){
# input:
# g=a vector of diagnosed individual statuses
# Y=a vector of true individual statuses
# return:
# an estimate of negative pooling predictive value
# =a proportion of truly negative subjects
# among subjects whose diagnosed statuses are negative
diag_neg <- which(g == 0)
ndiag_neg<- length(diag_neg)
#avoid the case "divided by 0"
if(ndiag_neg>0){
prop <- length(which(Y[diag_neg]==0))/ndiag_neg
}
#error handling
else{
prop <- -1
message("can not estimate negative predictive value")
}
return(prop)
}
# purpose: compute positive predictive value
ppv <- function(g, Y) {
# input:
# g=a vector of diagnosed individual statuses
# Y=a vector of true individual statuses
# return:
# an estimate of positive pooling predictive value
# =a proportion of truly positive subjects
# among subjects whose diagnosed statuses are positive
diag_pos <- which(g==1)
ndiag_pos<- length(diag_pos)
#avoid the case "divided by 0"
if(ndiag_pos>0){
prop <- length(which(Y[diag_pos]==1))/ndiag_pos
}
#error handling
else{
prop <- -1
message("can not estimate positive predictive value")
}
return(prop)
}
# purpose: compute pooling specificity
pl_sp <- function(g, Y){
# input:
# g=a vector of diagnosed individual statuses
# Y=a vector of true individual statuses
# return:
# an estimate of pooling specificity
# =a proportion of correctly diagnosed subjects
# among subjects whose true statuses are negative
non_infected <- which(Y==0)
nneg <- length(non_infected)
#avoid the case "divided by 0"
if(nneg>0){
prop <- length(which(g[non_infected]==0))/nneg
}
#error handling
else{
prop <- -1
message("can not estimate pooling specificity")
}
return(prop)
}
# purpose: compute pooling sensitivity
pl_se <- function(g, Y){
# input:
# g=a vector of diagnosed individual statuses
# Y=a vector of true individual statuses
# return:
# an estimate of pooling sensitivity
# =a proportion of correctly diagnosed subjects
# among subjects whose true statuses are positive
infected <- which(Y==1)
npos <- length(infected)
#avoid the case "divided by 0"
if(npos>0){
prop <- length(which(g[infected]==1))/npos
}
#error handling
else{
prop <- -1
message("can not estimate pooling sensitivity")
}
return(prop)
}