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