if(getRversion() >= '2.15.1') utils::globalVariables(c("type", "conc"))
checkcontrols <- function(last = 10, id = NULL, db = "cytotox",
organism = "Vibrio fischeri",
endpoint = "%", qcc = c("R", "xbar"))
{
if (!(db %in% c("cytotox", "ecotox", "enzymes"))) stop("Database is not supported")
if (requireNamespace("RODBC")) {
channel <- RODBC::odbcConnect(db, uid="cytotox", pwd="cytotox", case="tolower")
} else {
stop("For this function, the RODBC package has to be installed and configured.")
}
if (db %in% c("cytotox","enzymes")) {
if (is.null(id[1])) {
platequery <- paste("SELECT plate FROM controls",
"GROUP BY plate ORDER BY plate DESC LIMIT", last)
plates <- RODBC::sqlQuery(channel, platequery)$plate
} else {
plates <- id
}
controlquery <- paste("SELECT plate, type, location, response FROM controls",
"WHERE plate IN (", paste(plates, collapse = ", "), ")")
controldata <- RODBC::sqlQuery(channel,controlquery)
} else {
if (is.null(id[1])) {
lastquery = paste0("SELECT experiment FROM ecotox ",
"WHERE type LIKE '", endpoint, "' ",
"GROUP BY experiment ORDER BY experiment DESC LIMIT ", last)
res <- RODBC::sqlQuery(channel, lastquery)
if (nrow(res) == 0) {
stop("No results for endpoint", endpoint)
} else {
experiments <- res$experiment
}
} else {
experiments <- id
}
expquery <- paste("SELECT ",
"experimentator, substance, organism, conc, unit, response, ",
"performed, ok ",
"FROM ecotox ",
"WHERE experiment IN (", paste(experiments, collapse = ", "), ") ",
"AND organism LIKE '", organism, "' ",
"AND type LIKE '", endpoint, "'", sep = "")
expdata <- RODBC::sqlQuery(channel, expquery)
}
RODBC::odbcClose(channel)
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)
}
if (db == "ecotox") {
endpoint_string = if(endpoint == "%") "any endpoint" else paste("endpoint", endpoint)
cat("\nExperiments ", paste(experiments, collapse = ", "),
" from database ecotox for ", endpoint_string, " for ", organism, ":\n\n", sep = "")
} else {
cat("\nPlates ", paste(plates, collapse = ", "),
" from database ", db, ":\n\n", sep = "")
}
print(QA)
if (!is.na(qcc[1])) {
op <- par(ask=TRUE)
on.exit(par(op))
requireNamespace("reshape2")
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=4 sw=4 expandtab:
