From 9b36a3d2055d3bfa4844ca43acc232f064856871 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Fri, 31 Mar 2017 12:10:59 +0200
Subject: Further improvement to checkcontrols()

Static documentation rebuilt by pkgdown::build_site()
---
 R/checkcontrols.R | 65 ++++++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 50 insertions(+), 15 deletions(-)

(limited to 'R')

diff --git a/R/checkcontrols.R b/R/checkcontrols.R
index df9a2f9..d996d18 100644
--- a/R/checkcontrols.R
+++ b/R/checkcontrols.R
@@ -1,5 +1,6 @@
 if(getRversion() >= '2.15.1') utils::globalVariables(c("type", "conc"))
 checkcontrols <- function(last = 10, id = NULL, db = "cytotox",
+                          celltype = "IPC-81", enzymetype = "AChE",
                           organism = "Vibrio fischeri",
                           endpoint = "%", qcc = c("R", "xbar"))
 {
@@ -14,8 +15,17 @@ checkcontrols <- function(last = 10, id = NULL, db = "cytotox",
 
     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)
+            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 <- RODBC::sqlQuery(channel, platequery)$plate
         } else {
             plates <- id
@@ -25,26 +35,39 @@ checkcontrols <- function(last = 10, id = NULL, db = "cytotox",
         controldata <- RODBC::sqlQuery(channel,controlquery)
     } else {
         if (is.null(id[1])) {
-            lastquery = paste0("SELECT experiment FROM ecotox ",
-                "WHERE type LIKE '", endpoint, "' ",
+            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 <- RODBC::sqlQuery(channel, 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 <- paste("SELECT ",
-            "experimentator, substance, organism, conc, unit, response, ",
+        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, "'", sep = "")
+            "AND type LIKE '", endpoint, "'")
         expdata <- RODBC::sqlQuery(channel, 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
     }
 
     RODBC::odbcClose(channel)
@@ -76,13 +99,17 @@ checkcontrols <- function(last = 10, id = NULL, db = "cytotox",
                                               QA["Control (conc = 0)", 2],2)
     }
 
+    # The report
+    cat("\nDatabase", db, "\n")
+
     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 = "")
+        cat("Organism", organism, "\n")
+        cat("Endpoint", unique(expdata$type), "\n")
+        cat("\nExperiments ", paste(experiments, collapse = ", "), "\n\n")
     } else {
-        cat("\nPlates ", paste(plates, collapse = ", "),
-            " from database ", db, ":\n\n", sep = "")
+        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)
 
@@ -90,9 +117,17 @@ checkcontrols <- function(last = 10, id = NULL, db = "cytotox",
         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 (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",
-- 
cgit v1.2.1