Positive/Negative Predictive Values from Sensitivity, Sepcificity, Prevalence

## Settings for RMarkdown http://yihui.name/knitr/options#chunk_options
opts_chunk$set(comment = "", warning = FALSE, message = FALSE, tidy = FALSE, 
    echo = TRUE, fig.width = 5, fig.height = 5)
options(width = 116, scipen = 10)

setwd("~/statistics/Rmedstats/")

Define a function

table.2x2 <- function(prevalence, sensitivity, specificity, total.number = 1) {
    p <- prevalence
    sens <- sensitivity
    spec <- specificity

    TP <- p * sens
    FN <- p - TP
    TN <- (1 - p) * spec
    FP <- (1 - p) - TN

    table <- matrix(c(TP,FP,FN,TN), ncol = 2, byrow = TRUE)
    table <- table * total.number

    dimnames(table) <- list(test = c("pos", "neg"),
                            disease = c("pos", "neg"))

    PPV <- TP / (TP + FP)
    NPV <- TN / (TN + FN)
    LR.pos <- sens / (1 - spec)
    LR.neg <- (1 - sens) / spec

    probabilities <- c(PPV = PPV, NPV = NPV, "LR+" = LR.pos, "LR-" = LR.neg)

    list(table = addmargins(table),
         probabilities = probabilities
         )

}

Prevalence 10%, Sensitivity 99%, Specificity 99%

table.2x2(0.1, 0.99, 0.99)

$table
     disease
test    pos   neg   Sum
  pos 0.099 0.009 0.108
  neg 0.001 0.891 0.892
  Sum 0.100 0.900 1.000

$probabilities
    PPV     NPV     LR+     LR- 
 0.9167  0.9989 99.0000  0.0101 

PPV = 91.7%

Prevalence 1%, Sensitivity 99%, Specificity 99%

table.2x2(1/106, 0.99, 0.99)

$table
     disease
test         pos      neg     Sum
  pos 0.00933962 0.009906 0.01925
  neg 0.00009434 0.980660 0.98075
  Sum 0.00943396 0.990566 1.00000

$probabilities
    PPV     NPV     LR+     LR- 
 0.4853  0.9999 99.0000  0.0101 

PPV = 48.5%