Sample size for demonstrating freedom using pooled testing

This utility calcuates the number of pools required to be tested to provide a desired probability of detecting disease herd-sensitivity at the specified design prevalence, for a large (infinite) population, using pooled testing and assuming a fixed pool size and a test of known and 100% specificity. These analyses are an adaptation of the method from Cowling et el. (1999) (Prev Vet Med, 39:211-225), assuming known test sensitivity, perfect test specificity and 1 or more pools positive to declare a population infected (i.e. to be recognised as free there must be zero positive pools).

Inputs are the pool size used, pool-level test sensitivity, desired herd-sensitivity and design (target) prevalence. Test sensitivity is measured at the pool level (i.e. the probability that a pool will test positively if it represents one or more infected animals).

No results

No example available

No references available

				################################################################

# program to calculate confidence in disease freedom using pooled testing

################################################################



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:12])

# cat(a1)



# initialise variables

pool.size<- a1[1]

n.pools<- a1[2]

Sens<- a1[3]

conf<- a1[4]        # upper confidence limit

design.prev<- a1[5]

digits<- 4

pool.sizes<- c(1, 2, 3, 4, 5, 10, 15, 20, 25, 30, 40, 50, 100)

prev.levels<- c(design.prev, 0.005, 0.01, 0.02, 0.03, 0.04, 0.05, 0.1, 0.2)



# table of inputs

inputs<- array("", dim = c(length(a1)-1, 1))

inputs[, 1]<- a1[c(1, 3:length(a1))]

rownames(inputs)<- c("Pool size", "Pool sensitivity", "Confidence level", "Design prevalence")



sens.poolsize<- 0

sens.poolsize[1:length(pool.sizes)]<- Sens

names(a1)<- c("Pool size", "Number of pools", "Sensitivity", "Confidence level", "Design prevalence")

filename<- digest(Sys.time)

graphfile<- paste(fpath, "tmp/", filename, ".png", sep="")

sinkfile<- paste(fpath, "tmp/", filename, ".txt", sep="")

sink(sinkfile)



# popuulation sensitivity with pooled sampling

sep.pooled<- function(r, k, pstar, pse, psp=1) {

  # r = number of pools sampled (scalar or vector)

  # k = pool size (constant)  (scalar or vector)

  # pstar = design prevalence

  # pse = pool-level sensitivity

  # psp = pool-level specificity

  # value: returns list of 2 elements, vector of sep values and vector of spp values

  sep<- 1 - ((1 - (1 - pstar)^k)*(1 - pse) + (1 - pstar)^k * psp)^r

  spp<- psp^r

  return(list(sep=sep, spp=spp))

}



# sample size for pooled testing for freedom

n.pooled<- function(sep, k, pstar, pse, psp=1) {

  # sep = desired population sensitivity (scalar or vector)

  # k = pool size (constant)  (scalar or vector)

  # pstar = design prevalence

  # pse = pool-level sensitivity

  # psp = pool-level specificity

  n<- log(1-sep)/log(((1 - (1 - pstar)^k)*(1 - pse) + (1 - pstar)^k * psp))

  return(ceiling(n))

}





# result1<- round(Prevalence(n.pools, pool.size, conf, Sens), digits)



# result2<- round(optimise(Confidence, c(0, 1), maximum = FALSE, m=n.pools, k=pool.size, Sens=Sens, prev=design.prev)$minimum, digits)



result3<- n.pooled(conf, pool.size, design.prev, Sens)



sample.sizes<- array(0, dim = c(length(pool.sizes), 9))

for (i in 1:length(pool.sizes)) {

    sample.sizes[i,]<- n.pooled(conf, pool.sizes[i], prev.levels, Sens)

}

colnames(sample.sizes)<- paste("Prevalence = ", prev.levels, sep = "")

rownames(sample.sizes)<- paste("Pool size = ", pool.sizes, sep = "")

n.lines<- 8              # length(pool.sizes)



# graph results

    Title<-c("Pooled testing for Demonstrating Disease Freedom")

    OpenGraphOutput(graphfile, pointsize = 12, ht = 6, wd = 8)

    line.colours<- c("darkblue", "red", "darkgreen", "magenta", "brown", "purple", "black", "blue", "darkred", "tan")

    plot(x = prev.levels[2:9], y = sample.sizes[1,2:9], type="n", ylab = "No. of pools", ylim = c(0, max(sample.sizes[], na.rm = TRUE)),

                xlim = c(0, 0.1), xlab="Prevalence", main=Title, col = line.colours[1])

    for (i in 1:n.lines) {

        lines(x = prev.levels[2:9], y = sample.sizes[i, 2:9], type = "l", col = line.colours[i])

    }

    legend.txt<- rownames(sample.sizes)[1:n.lines]

    legend(0.1, max(sample.sizes[], na.rm = TRUE), legend.txt, xjust = 1, yjust = 1,

        col = line.colours, lty = c(1, 1), plot = TRUE, cex = 0.7)

    CloseGraphOutput("R")

sink()





# write to html and file

heading<- "Sample size to demonstrate freedom using pooled testing"

subheadings<- "Sample sizes for varying prevalence and pool size"

tmp.file<- paste(fpath, "tmp/", filename, sep = "")

result.txt<- paste("For a pool size of ", pool.size, ", a minimum of ", result3, " pools must be tested to provide ", conf*100, "% probability of detecting a prevalence of ", design.prev, ".
",

              "
The table and graph below show the number of pools required for various pool sizes to provide ", conf*100, "% confidence of detecting a prevalence of ", design.prev, " and assuming a test sensitivity of ", Sens, " for all pool sizes.", sep = "")

output<- html.output(heading, subheadings, inputs, results = list(sample.sizes), graphs = graphfile, graph.headings = "Plot of sample sizes", show.inputs = T, show.graphs = T, tmp.file, result.txt = result.txt) 

write.html(output, tmp.file)

cat(output)