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: