Likelihood ratios and probability of infection

Use this to calculate positive and negative likelihood ratios for a test of given sensitivity and specificity and to calculate the post-test probability of infection, given the pre-test probability and test performance. For these calculations, the pre-test probability of disease is the estimated of probability of infection based on clinical signs and any other (such as previous test results) available information. If no other information is available the estimated prevalence of disease in the population of origin should be used. The post-test probability of disease is the same as the positive (or negative) predictive value for the test for the specified pre-test probability of disease.

No results

No example available

No references available

				######################################
# Program to calculate Probability of infection in an individual tested animal
######################################


# 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<- type.convert(a0[8:10])

# cat(a0)
# cat(a1)
digits<- 4
Prevalence<- a1[1]
Se<- a1[2]
Sp<- a1[3]
names(a1)<- c("Pre-test probability of infection", "Sensitivity", "Specificity")
filename<-  digest(Sys.time())
graphfile<- paste(fpath, "tmp/", filename, ".png", sep="")
sinkfile<- paste(fpath, "tmp/", filename, ".txt", sep="")
sink(sinkfile)

# table of inputs
inputs<- array("", dim = c(length(a1), 1))
inputs[1:length(a1), 1]<- a1[1:length(a1)]
rownames(inputs)<- names(a1)


LRpos<- Se/(1 - Sp)
LRneg<- (1 - Se)/Sp
PreTestOdds<- Prevalence/(1 - Prevalence)
PostTestOddsPos<- PreTestOdds*LRpos
PostTestOddsNeg<- PreTestOdds*LRneg
P.pos<- PostTestOddsPos/(1+PostTestOddsPos)
P.neg<- PostTestOddsNeg/(1+PostTestOddsNeg)

results<- array(0, dim = c(4, 2))
rownames(results)<- c("Pre-test odds of disease", "Likelihood Ratio",
        "Post-test odds of disease", "Post-test probability of disease (PPV & 1 - NPV)")
colnames(results)<- c("Positive result", "Negative result")
results[1,]<- PreTestOdds
results[2, 1]<- LRpos
results[3, 1]<- PostTestOddsPos
results[4, 1]<- P.pos
results[2, 2]<- LRneg
results[3, 2]<- PostTestOddsNeg
results[4, 2]<- P.neg

results<- round(results, digits)

S1<- c(0.5, 0.9, 0.95, 0.99, 0.999)
S2<- c(0.5, 0.6, 0.7, 0.8, 0.9, 0.95, 0.96, 0.97, 0.98, 0.99, 0.999)
LR<- array(0, dim = c(length(S2), length(S1), 2))
for (i in 1:length(S1)) {
for (j in 1:length(S2)) {
    LR[j, i, 1]<- S1[i]/(1 - S2[j])
    LR[j, i, 2]<- (1 - S1[i])/S2[j]
}
}
LR1<- array(0, dim = c(length(S1), length(S2), 2))
for (i in 1:length(S2)) {
for (j in 1:length(S1)) {
    LR1[j, i, 1]<- S2[i]/(1 - S1[j])             # LRP
    LR1[j, i, 2]<- (1 - S2[i])/S1[j]             # LRN
}
}

# graph results
    OpenGraphOutput(graphfile, pointsize = 12, ht = 10, wd = 10)
    line.colours<- c("darkblue", "red", "darkgreen", "purple", "brown")
    par(mfrow = c(2,2))
    # LRP
    Title<-c("Likelihood ratios for positive result")
    plot(x = S2, y = LR[,1,1], type="l", xlab = "Specificity", ylim = c(0, max(LR)),
                xlim = c(0.9, 1), ylab="Likelihood Ratio", main=Title, col=line.colours[1])
    for (i in 2:length(S1)) {
        lines(S2, LR[,i,1], type="l",  col=line.colours[i])
    }
    legend(0.9, max(LR), paste("Se = ", S1, sep = ""), xjust = 0, yjust = 1,
        col=line.colours, lty = c(1, 1), plot = TRUE, cex = 0.7)
    # LRN
    Title<-c("Likelihood ratios for negative result")
    plot(x = S2, y = LR[,1,2], type="l", xlab = "Specificity", ylim = c(0, 1),
                xlim = c(min(S2), 1), ylab="Likelihood Ratio", main=Title, col=line.colours[1])
    for (i in 2:length(S1)) {
        lines(S2, LR[,i,2], type="l",  col=line.colours[i])
    }
    legend(1, 1, paste("Se = ", S1, sep = ""), xjust = 1, yjust = 1,
        col=line.colours, lty = c(1, 1), plot = TRUE, cex = 0.7)
    # LRP
    Title<-c("Likelihood ratios for positive result")
    plot(x = S2, y = LR1[1,,1], type="l", xlab = "Sensitivity", ylim = c(0, max(LR1)),
                xlim = c(min(S2), 1), ylab="Likelihood Ratio", main=Title, col=line.colours[1])
    for (i in 2:length(S1)) {
        lines(S2, LR1[i,,1], type="l",  col=line.colours[i])
    }
    legend(min(S2), max(LR1), paste("Sp = ", S1, sep = ""), xjust = 0, yjust = 1,
        col=line.colours, lty = c(1, 1), plot = TRUE, cex = 0.7)
    # LRN
    Title<-c("Likelihood ratios for negative result")
    plot(x = S2, y = LR1[1,,2], type="l", xlab = "Sensitivity", ylim = c(0, 1),
                xlim = c(min(S2), 1), ylab="Likelihood Ratio", main=Title, col=line.colours[1])
    for (i in 2:length(S1)) {
        lines(S2, LR1[i,,2], type="l",  col=line.colours[i])
    }
    legend(1, 1, paste("Sp = ", S1, sep = ""), xjust = 1, yjust = 1,
        col=line.colours, lty = c(1, 1), plot = TRUE, cex = 0.7)
    CloseGraphOutput("B")
sink()


# write to html and file
heading<- "Likelihood ratios and probability of infection in a tested individual"
subheadings<- ""
tmp.file<- paste(fpath, "tmp/", filename, sep = "")
result.txt<- "The table below summarises the probability of infection in test-positive and test-negative individuals, respectively."
output<- html.output(heading, subheadings, inputs, results = list(results), graphs = graphfile, graph.headings = "Plots of positive and negative likelihood ratios", show.inputs = T, show.graphs = T, tmp.file, result.txt = result.txt) 
write.html(output, tmp.file)
cat(output)