diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/checkcontrols.R | 65 |
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", |