R/checkcontrols.R

In drfit: Dose-Response Data Evaluation

utils::globalVariables(c("type", "conc"))
checkcontrols <- function(last = 10, id = NULL, db = c("cytotox", "enzymes", "ecotox"),
                          celltype = "IPC-81", enzymetype = "AChE",
                          organism = "Vibrio fischeri",
                          endpoint = "%", qcc = c("R", "xbar"))
{
  db <- match.arg(db)

  con <- dbConnect(odbc(), "cytotox", database = db)

  if (db %in% c("cytotox","enzymes")) {
    if (is.null(id[1])) {
      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 <- dbGetQuery(con, platequery)$plate
    } else {
      plates <- id
    }
    controlquery <- paste("SELECT plate, type, location, response FROM controls",
      "WHERE plate IN (", paste(plates, collapse = ", "), ")")
    controldata <- dbGetQuery(con,controlquery)
  } else {
    if (is.null(id[1])) {
      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 <- dbGetQuery(con, 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 <- 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, "'")
    expdata <- dbGetQuery(con, 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
  }

  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)
  }

  # The report
  cat("\nDatabase", db, "\n")

  if (db == "ecotox") {
      cat("Organism", organism, "\n")
      cat("Endpoint", unique(expdata$type), "\n")
      cat("\nExperiments ", paste(experiments, collapse = ", "), "\n\n")
  } else {
      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)

  if (!is.na(qcc[1])) {
      op <- par(ask=TRUE)
      on.exit(par(op))
      requireNamespace("reshape2")
      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",
              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=2 sw=2 expandtab: