aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
Diffstat (limited to 'R')
-rw-r--r--R/checkcontrols.R65
1 files changed, 50 insertions, 15 deletions
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",

Contact - Imprint