aboutsummaryrefslogblamecommitdiff
path: root/R/checkcontrols.R
blob: df9a2f9d92af7726d7a62a4ba321f4a531adbbcd (plain) (tree)













































































































                                                                                                
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