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

Contact - Imprint