Add function to control controls

2 files changed, 158 insertions, 0 deletions

diff --git a/R/checkcontrols.R b/R/checkcontrols.R
new file mode 100644
index 0000000..df9a2f9
--- /dev/null
+++ b/R/checkcontrols.R
@@ -0,0 +1,110 @@
+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:
diff --git a/man/checkcontrols.Rd b/man/checkcontrols.Rd
new file mode 100644
index 0000000..b155643
--- /dev/null
+++ b/man/checkcontrols.Rd
@@ -0,0 +1,48 @@
+\name{checkcontrols}
+\alias{checkcontrols}
+\title{Check raw data from range of plates or experiments}
+\description{
+  Report control data from a specified range of microtiter plates or
+  experiments from a specified database.
+}
+\usage{
+  checkcontrols(last = 10, id = NULL, db = "cytotox", organism = "Vibrio fischeri", 
+                endpoint = "\%", qcc = c("R", "xbar"))
+}
+\arguments{
+  \item{last}{
+    If \code{id} is not specified, this argument specifies the number of
+    plates/experiments that should be evaluated. The plates/experiments with
+    the hightest numbers are selected.
+  }
+  \item{id}{
+    A numeric vector of integers, specifying the plates or experiments explicitly.
+  }
+  \item{db}{
+    The database to be used. Currently, the microtiter plate databases
+    "cytotox", "enzymes" of the UFT Department of Bioorganic Chemistry are
+    supported, as well as the database of ecotoxicity experiments "ecotox".}
+  \item{organism}{
+    The organism that was exposed to the chemical. Only important if the database
+    "ecotox" is used. Defaults to "Vibrio fischeri".}
+  \item{endpoint}{
+    The endpoint that should be used for selecting the data. Only important if
+    the database "ecotox" is used. Defaults to "\%".}
+  \item{qcc}{
+    The type of quality control charts to be plotted. By default, an R chart 
+    (showing ranges of control values within plates/experiments), and an 
+    xbar chart (showing means) are generated. 
+  }
+}
+\value{
+  The function lists a report and shows two graphs.
+}
+\examples{
+\dontrun{checkcontrols(15)}
+}
+\author{
+  Johannes Ranke 
+  \email{jranke@uni-bremen.de} 
+  \url{http://www.uft.uni-bremen.de/chemie/ranke}
+}
+\keyword{database}