utils::globalVariables(c("type", "conc"))
checkcontrols <- function(last = 10, id = NULL, db = c("cytotox", "enzymes", "ecotox"),
celltype = "IPC-81", enzymetype = "AChE",
organism = "Vibrio fischeri",
endpoint = "%", qcc = c("R", "xbar"))
{
db <- match.arg(db)
con <- dbConnect(odbc(), "cytotox", database = db)
if (db %in% c("cytotox","enzymes")) {
if (is.null(id[1])) {
platequery <- "SELECT plate FROM"
if (db == "cytotox") {
platequery <- paste0(platequery, " cytotox WHERE celltype like '",
celltype, "'")
}
if (db == "enzymes") {
platequery <- paste0(platequery, " enzymes WHERE enzyme like '",
enzymetype, "'")
}
platequery <- paste(platequery,
"GROUP BY plate ORDER BY plate DESC LIMIT", last)
plates <- dbGetQuery(con, platequery)$plate
} else {
plates <- id
}
controlquery <- paste("SELECT plate, type, location, response FROM controls",
"WHERE plate IN (", paste(plates, collapse = ", "), ")")
controldata <- dbGetQuery(con,controlquery)
} else {
if (is.null(id[1])) {
lastquery = paste0("SELECT experiment, type FROM ecotox ",
"WHERE organism LIKE '", organism, "'",
"AND type LIKE '", endpoint, "' ",
"GROUP BY experiment ORDER BY experiment DESC LIMIT ", last)
res <- dbGetQuery(con, lastquery)
if (nrow(res) == 0) {
stop("No results for endpoint", endpoint)
} else {
if (nlevels(res$type) > 1) {
stop("Found more than one endpoint type:\n",
paste(levels(res$type), collapse = ", "), "\n",
"Please specify an endpoint in your call to checkcontrols()")
}
experiments <- res$experiment
}
} else {
experiments <- id
}
expquery <- paste0("SELECT ",
"experimentator, experiment, substance, organism, type, conc, unit, raw_response, ",
"performed, ok ",
"FROM ecotox ",
"WHERE experiment IN (", paste(experiments, collapse = ", "), ") ",
"AND organism LIKE '", organism, "' ",
"AND type LIKE '", endpoint, "'")
expdata <- dbGetQuery(con, expquery)
if (nlevels(expdata$type) > 1) {
stop("Found more than one endpoint type:\n",
paste(levels(expdata$type), collapse = ", "), "\n",
"Please specify an endpoint in your call to checkcontrols()")
}
# Use the raw response for QA
expdata$response <- expdata$raw_response
}
if (db %in% c("cytotox","enzymes")) {
blinds <- subset(controldata, type == "blind")
controls <- subset(controldata, type == "control")
QA <- matrix(nrow = 2, ncol = 4,
dimnames = list(c("Blind", "Control (conc = 0)"),
c("Number", "Mean", "Std. Dev.", "% Std. Dev")))
QA[1, 1] <- length(blinds$response)
QA[1, 2] <- signif(mean(blinds$response), 2)
QA[1, 3] <- signif(sd(blinds$response), 2)
QA[1, 4] <-signif(QA[1, 3] * 100 / QA[1, 2],2)
} else {
controls <- subset(expdata, conc == 0)
QA <- matrix(nrow = 1, ncol = 4,
dimnames = list(c("Control (conc = 0)"),
c("Number", "Mean", "Std. Dev.", "% Std. Dev")))
}
numberOfControls <- length(controls$response)
QA["Control (conc = 0)", 1] <- numberOfControls
if (numberOfControls > 0) {
QA["Control (conc = 0)", 2] <- signif(mean(controls$response),2)
QA["Control (conc = 0)", 3] <- signif(sd(controls$response),2)
QA["Control (conc = 0)", 4] <- signif(QA["Control (conc = 0)", 3] * 100 /
QA["Control (conc = 0)", 2],2)
}
# The report
cat("\nDatabase", db, "\n")
if (db == "ecotox") {
cat("Organism", organism, "\n")
cat("Endpoint", unique(expdata$type), "\n")
cat("\nExperiments ", paste(experiments, collapse = ", "), "\n\n")
} else {
if (db == "cytotox") cat ("Cell type", celltype, "\n")
if (db == "enzymes") cat ("Enzyme type", enzymetype, "\n")
cat("\nPlates", paste(plates, collapse = ", "), "\n\n")
}
print(QA)
if (!is.na(qcc[1])) {
op <- par(ask=TRUE)
on.exit(par(op))
requireNamespace("reshape2")
if (db == "ecotox") {
controls$row <- rownames(controls)
controls_molten <- melt(controls[c("experiment", "row", "response")],
id = c("experiment", "row"))
controls_wide <- acast(controls_molten, formula = experiment ~ row)
} else {
controls_molten <- melt(controls[c("plate", "location", "response")],
id = c("plate", "location"))
controls_wide <- acast(controls_molten, formula = plate ~ location)
}
if ("R" %in% qcc) {
qcc(controls_wide, type = "R", nsigmas = 3,
title = "Range chart",
data.name = "Controls (conc = 0)")
}
if ("xbar" %in% qcc) {
qcc(controls_wide, type = "xbar", nsigmas = 3,
title = "Mean chart",
data.name = "Controls (conc = 0)")
}
}
invisible(controls)
}
# vim: ts=2 sw=2 expandtab:
