Dynamic Cluster Detection using pl/r functions
The ability to detect clusters of outbreaks as soon as possible was investigated. Cluster detection methods were coded as procedural language functions in the database and made available through a web interface6. Methods available through this interface include CUSUM (Rossi et al., 1999), log-linear regression (Farrington et al., 1996), generalised likelihood ratio (Höhle et al., 2009) and Bayesian (Reibler, 2004 in German, cited in Höhle, 2007) algorithms provided through the R package Surveillance (Höhle, 2007).
The example code below illustrates the code for the Farrington log-linear regression model.
PL/R Function
CREATE OR REPLACE FUNCTION outbreak_farr_uni(bound integer, startweek date, endweek date, back integer, wind integer, serotype varchar, directory text) RETURNS text
AS $_$
db<-NA
this_filename = basename(tempfile("outbreak_cdc_uni", directory))
this_file = file.path(directory, this_filename)
library(Cairo)
library(zoo)
library(rgeos)
library(surveillance)
gpclibPermit()
if(serotype=='') {
serotype='all'
}
q <- "SELECT datefrom AS reportdate, count(gid) FROM outbreaks "
if(serotype != 'all') {
q<- paste(q, " WHERE serotype = '",serotype,"' ", sep='')
}
q <- paste(q, "GROUP BY datefrom ORDER BY datefrom")
res <- dbGetQuery(db, q)
rez <- zoo(res$count, res$reportdate)
# Aggregate by week - friday... why not.
aggregate(rez, agg.by.fri, sum) -> rey
# Convert back to ts
tmp <- as.matrix(as.ts(rey))
dates <- as.Date("2000-01-07") + 7 * 0:(nrow(tmp) - 1)
# Create sts class
red <- new("sts",epoch=1:nrow(tmp), start=c(2000,1), freq=52, observed=tmp, state=matrix(0,nrow(tmp), ncol(tmp)), epochAsDate=FALSE)
# Replace NA's with 0
red@observed[is.na(red@observed)]<- 0
# Add a reasonable upper bound?
red@upperbound <- as.matrix(rep(quantile(red@observed, bound/100), length(observed(red))), 1, length(observed(red)))
red@state[red@observed > red@upperbound] <- 1
period <- which(dates >= startweek & dates <= endweek)
red.farr <- farrington(red, control=list(range = period, b=back, w=wind))
Cairo(paste(this_file, ".png", sep = ""), type='png', height=768, width=1024)
plot(red.farr, main = 'Log-linear regression of outbreak reports', sub='after Farrington et al, 1996', xlab='Year / Quarter', ylab='Reports per week', legend.opts=list(horiz=TRUE, bty='n'))
dev.off()
Cairo(paste(this_file, ".pdf", sep = ""), type='pdf', title='Created by ACIAR ULM Project', height=30, width=40, units='cm')
plot(red.farr, main = 'Log-linear regression of outbreak reports', sub='after Farrington et al, 1996', xlab='Year / Quarter', ylab='Reports per week', legend.opts=list(horiz=TRUE, bty='n'))
dev.off()
system(paste("chmod 666 ", this_file, ".png", sep=""), intern = FALSE, ignore.stderr = TRUE)
system(paste("chmod 666 ", this_file, ".pdf", sep=""), intern = FALSE, ignore.stderr = TRUE)
return(this_filename)
$_$ LANGUAGE plr;
If you copy and paste this code into psql it should produce a working function.
I have it embedded in a web page with four other algorithms, where the code (in php) looks a bit like :
/*
* Farrington
*/
echo "<div id='farrington' class='thumbnail'>";
echo "<h3>Log-linear regression model (Farrington et al, 1996)</h3>";
$q= "SELECT outbreak_farr_uni(:bound, :startweek, :endweek, :back, :wind, :serotype, :plr_tmp)";
$iarray=array(":bound" => $bound, ":startweek" => $startweek, ":endweek" => $endweek, ":back" => $back, ":wind" => $wind, ":serotype" => $serotype, ":plr_tmp" => $plr_tmp);
$query = $dpg->prepare($q);
try {
$query->execute($iarray);
$result = $query->fetchColumn();
echo "<a onclick='return bigimage(\"tmp/$result\", 1024,678)'><img src='tmp/".$result.".png' width='320' height='240'></a>";
} catch(exception $e) {
echo "<br><b>There was an error with this algorithm.</b><p>A common cause is a lack of consistent data during the selected date range, please check the parameters (and have a look at the Analysis Range in the Full outbreak listing above).</p><br><br><br>";
}
echo "<p>b: <input type='text' name='back' size='2' maxlength='2' value='$back'> </p>
<p>
m: <input type='text' name='wind' size='2' maxlength='2' value='$wind'></p>";
echo "<br></div>";
Which should produce a thumbnail chart in the page.
Thumbnail embedded in page
Clicking on the plot opens a window with a powerpoint sized (1024 x 768) large png version, and has a link to download a pdf version (for embedding in documents etc).
Window with download link
References
Farrington, C., Andrews, N., Beale, A., and Catchpole, M. (1996). A statistical algorithm for the early detection of outbreaks of infectious disease. Journal of the Royal Statistical Society. Series A (Statistics in Society), 159(3):547–563.
Höhle, M. (2007). surveillance: An R package for the monitoring of infectious diseases. Computational Statistics, 22(4):571–582.
Höhle, M., Paul, M., and Held, L. (2009). Statistical approaches to the monitoring and surveillance of infectious diseases for veterinary public health. Preventive Veterinary Medicine, 91(1):2–10.
Rossi, G., Lampugnani, L., and Marchi, M. (1999). An approximate CUSUM procedure for surveillance of health events. Statistics in Medicine, 18(16):2111–2122.
