trace tracker logo

Positive and Negative Predictive Values

Use this to calculate the positive and negative predictive values for a test of known sensitivity and specificity for a range of prior probabilities of infection.

No results

No example available
No references available
				######################################
# Program to calculate Predictive values for a test
######################################


# check version and load header script
rm(list = ls())
test<- ifelse(length(commandArgs()) < 3, TRUE, FALSE)
fpath<- ifelse(test, "webRootUrl", "rtoolsPath")

# load header scripts
  source(paste(fpath, "R/epi_head.R", sep = ""))
  source(paste(fpath, "R/HTMLStream.R", sep = ""))
  source(paste(fpath, "R/epitools_functions.r", sep = ""))


# extract command arguments
    a1<- a0[8:11]

# cat(a0)
# cat(a1)
digits<- 4
test1<- a1[1]
Se<- type.convert(a1[2])
Sp<- type.convert(a1[3])
Prev<- type.convert(a1[4])

# table of inputs
inputs<- array("", dim = c(length(a1), 1))
inputs[1:length(a1), 1]<- a1[1:length(a1)]
rownames(inputs)<- c("Test", "Sensitivity", "Specificity", "Prior probability of infection")

filename<- digest(Sys.time())
graphfile<- paste(fpath, "tmp/", filename, ".png", sep="")
sinkfile<- paste(fpath, "tmp/", filename, ".txt", sep="")
# cat(a1)
results<- array(0, dim = c(19, 3))
colnames(results)<- c("Prior probability of infection", "Positive Predictive Value", "Negative Predictive Value")
results[,1]<- c(0, 0.01, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.4, 0.5, 0.6, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 0.99, 1)
results[,2]<- results[,1]*Se/(results[,1]*Se + (1 - results[,1])*(1 - Sp))
results[,3]<- (1 - results[,1])*Sp/((1 - results[,1])*Sp + results[,1]*(1 - Se))

PPV<- round(Prev*Se/(Prev*Se + (1 - Prev)*(1 - Sp)), digits)
NPV<- round((1 - Prev)*Sp/((1 - Prev)*Sp + Prev*(1 - Se)), digits)

results<- round(results, digits)
# cat(results)
# graph results
sink(sinkfile)
    Title<-c("Positive and Negative Predictive Values")
    OpenGraphOutput(graphfile, pointsize = 12, ht = 6, wd = 8)
    plot(results[,1], results[,2], type="l", xlab="Prior probability of infection",
                ylab="Predictive Value", main=Title, col="darkblue")
    lines(results[,1], results[,3], type="l",  col="red", lty = "dashed", lwd = 2)
    legend(0.5, 0,
        c("PPV", "NPV"), xjust = 0.5, yjust = 0,
        col=c("darkblue", "red"), lty = c("solid", "dashed"), lwd = c(1, 2), plot = TRUE, cex = 0.7)
    CloseGraphOutput("B")
sink()

# write to html and file
heading<- "Postive and negative predictive values for a test"
subheadings<- ""
tmp.file<- paste(fpath, "tmp/", filename, sep = "")
result.txt<- paste("The positive predictive value (PPV) for sensitivity = ", Se, ", specificity = ", Sp, " and prior probability of infection = ", Prev, " is ", PPV, ".
", "The negative predictive value (NPV) for sensitivity = ", Se, ", specificity = ", Sp, " and prior probability of infection = ", Prev, " is ", NPV, ".", "

The table and graph below summarise the positive and negative predictive values for the test for a range of prior probabilities of infection.

", sep = "") output<- html.output(heading, subheadings, inputs, results = list(results), graphs = graphfile, graph.headings = "PPV and NPV for varying prior probability of infection", show.inputs = T, show.graphs = T, tmp.file, result.txt = result.txt) write.html(output, tmp.file) cat(output)