aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
Diffstat (limited to 'R')
-rw-r--r--R/checkcontrols.R243
-rw-r--r--R/checkexperiment.R371
-rw-r--r--R/checkplate.R4
-rw-r--r--R/checksubstance.R158
-rw-r--r--R/drdata.R80
5 files changed, 426 insertions, 430 deletions
diff --git a/R/checkcontrols.R b/R/checkcontrols.R
index d996d18..b071769 100644
--- a/R/checkcontrols.R
+++ b/R/checkcontrols.R
@@ -1,145 +1,138 @@
-if(getRversion() >= '2.15.1') utils::globalVariables(c("type", "conc"))
-checkcontrols <- function(last = 10, id = NULL, db = "cytotox",
+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)
- if (!(db %in% c("cytotox", "ecotox", "enzymes"))) stop("Database is not supported")
+ con <- dbConnect(odbc(), "cytotox", database = db)
- if (requireNamespace("RODBC")) {
- channel <- RODBC::odbcConnect(db, uid="cytotox", pwd="cytotox", case="tolower")
+ 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 {
- stop("For this function, the RODBC package has to be installed and configured.")
+ plates <- id
}
-
- 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 <- RODBC::sqlQuery(channel, 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()")
}
- controlquery <- paste("SELECT plate, type, location, response FROM controls",
- "WHERE plate IN (", paste(plates, collapse = ", "), ")")
- controldata <- RODBC::sqlQuery(channel,controlquery)
+ experiments <- res$experiment
+ }
} 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 <- RODBC::sqlQuery(channel, 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 <- RODBC::sqlQuery(channel, 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
+ 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
+ }
- 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")))
- 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")))
+ }
- 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)
+ }
- 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")
- # 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 (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)
- 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)")
- }
- }
+ } 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)
+ invisible(controls)
}
-# vim: ts=4 sw=4 expandtab:
+# vim: ts=2 sw=2 expandtab:
diff --git a/R/checkexperiment.R b/R/checkexperiment.R
index 2806317..7fa1a60 100644
--- a/R/checkexperiment.R
+++ b/R/checkexperiment.R
@@ -1,190 +1,189 @@
-if(getRversion() >= '2.15.1') utils::globalVariables(c("type", "conc", "substance"))
-checkexperiment <- function(id, db = "ecotox", endpoint = "%")
-{
- databases <- data.frame(
- responsename=c("viability","activity","raw_response"),
- testtype=c("celltype","enzyme","organism"),
- exptype=c("plate","plate","experiment"))
- rownames(databases) <- c("cytotox","enzymes","ecotox")
-
- if (!(db %in% rownames(databases))) 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.")
- }
-
- responsename = as.character(databases[db,1])
- testtype = as.character(databases[db,2])
- exptype = as.character(databases[db,3])
-
- exptable <- paste(exptype, "s", sep="")
- commentquery <- paste("SELECT comment FROM ", exptable ,
- " WHERE ", exptype, " = ", id)
- commentdata <- RODBC::sqlQuery(channel,commentquery)
- comment <- as.character(commentdata[[1]])
-
- expquery <- paste("SELECT experimentator, substance, ",
- testtype, ", conc, unit,", responsename, ", type, raw_0, duration, performed, ok",
- " FROM ",db," WHERE ",exptype,"=", id,
- sep = "")
-
- if (db == "ecotox") {
- expquery <- paste0(expquery, " AND type LIKE '", endpoint, "'")
- }
-
- expdata <- RODBC::sqlQuery(channel,expquery)
-
- if (db %in% c("cytotox","enzymes")) {
- controlquery <- paste("SELECT type,response FROM controls
- WHERE plate=",id)
- controldata <- RODBC::sqlQuery(channel,controlquery)
- }
-
- RODBC::odbcClose(channel)
-
- op <- par(ask=TRUE)
- on.exit(par(op))
-
- 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 {
- # Use raw response for ecotox
- expdata$response <- expdata$raw_response
-
- if (nlevels(expdata$type) > 1) {
- message("There are data for more than one type of raw response in your data.\n",
- "The types are ", paste(levels(expdata$type), collapse = " and "), ".\n",
- "You should choose one of these types using 'endpoint = \"$type\"'",
- "in your call to checkexperiment\n",
- "For now, we are continuing with the data for ", levels(expdata$type)[1])
- }
- endpoint <- expdata$type[1]
- expdata <- subset(expdata, type == endpoint)
-
- controls <- subset(expdata, conc == 0)
- expdata <- 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)
- }
+utils::globalVariables(c("type", "conc", "substance"))
- if (db == "ecotox") {
- if (identical(as.character(levels(expdata$organism)), "Vibrio fischeri")) {
- positive <- subset(expdata, substance == "Na Cl")
- if (nrow(positive) > 0) {
- QA <- rbind(QA,
- c(nrow(positive),
- signif(mean(positive$raw_response), 2),
- signif(sd(positive$raw_response), 2),
- signif(100 * sd(positive$raw_response) /
- mean(positive$raw_response), 2)))
-
- rownames(QA) <- c("Control (conc = 0)",
- "Positive control (Na Cl)")
- }
- expdata <- subset(expdata, substance != "Na Cl", drop = TRUE)
- }
- }
-
- if (length(expdata$experimentator) < 1) {
- stop("There is no response data for ",exptype," ",
- id," in database ",db,"\n")
- }
- exptypestring <- paste(toupper(substring(exptype,1,1)),
- substring(exptype,2),sep="")
- expdata$experimentator <- factor(expdata$experimentator)
- expdata$type <- factor(expdata[[testtype]])
- expdata$performed <- factor(as.character(expdata$performed))
- expdata$substance <- factor(expdata$substance)
- expdata$unit <- factor(expdata$unit)
- expdata$ok <- factor(expdata$ok)
-
- # Info on the experiment
- cat("\n",exptypestring,id,"from database",db,":\n\n",
- "\tExperimentator(s):\t",levels(expdata$experimentator),"\n",
- "\tType(s):\t\t",levels(expdata$type),"\n",
- "\tPerformed on:\t\t",levels(expdata$performed),"\n",
- "\tSubstance(s):\t\t",levels(expdata$substance),"\n",
- "\tConcentration unit(s):\t",levels(expdata$unit),"\n",
- "\tComment:\t\t",comment,"\n",
- "\tOK Levels:\t\t",levels(expdata$ok),"\n\n")
-
- print(QA)
-
- # Control growth rate for Lemna and algae
- if (endpoint %in% c("cell count", "frond area", "frond number")) {
- duration <- unique(expdata$duration) # in hours
- if (length(duration) > 1) stop("More than one duration in the data")
- response_0 <- unique(expdata$raw_0)
- if (length(response_0) > 1) stop("More than one mean response at time 0 in the data")
- t_days <- duration / 24
- control_growth_rates <- (log(controls$response) - log(response_0)) / t_days
- cat("\nMean growth rate in controls:\t", round(mean(control_growth_rates), 3), "per day\n")
- }
-
-
- # Box plot of control data
- if (db == "ecotox") {
- boxplot(controls$response,
- names="controls",
- ylab=endpoint,
- ylim=range(controls$response, na.rm = TRUE),
- boxwex=0.4,
- main=paste("Plate ",id))
- } else {
- boxplot(blinds$response,controls$response,
- names=c("blinds","controls"),
- ylab="Response",
- boxwex=0.4,
- main=paste("Plate ",id))
+checkexperiment <- function(id,
+ db = c("ecotox", "cytotox", "enzymes"),
+ endpoint = "%")
+{
+ db = match.arg(db)
+
+ databases <- data.frame(
+ responsename = c("viability", "activity", "raw_response"),
+ testtype = c("celltype", "enzyme", "organism"),
+ exptype = c("plate", "plate", "experiment"),
+ row.names = c("cytotox", "enzymes", "ecotox"),
+ stringsAsFactors = FALSE)
+
+ con <- dbConnect(odbc(), "cytotox", database = db)
+
+ responsename <- databases[db, 1]
+ testtype <- databases[db, 2]
+ exptype <- databases[db, 3]
+
+ exptable <- paste(exptype, "s", sep = "")
+
+ commentquery <- paste0("SELECT comment FROM ", exptable, " ",
+ "WHERE ", exptype, " = ", id)
+ commentdata <- dbGetQuery(con, commentquery)
+ comment <- as.character(commentdata[[1]])
+
+ expquery <- paste0("SELECT ",
+ "experimentator, substance, ", testtype, ", conc, unit,", responsename, ",
+ type, raw_0, duration, performed, ok ",
+ "FROM ", db, " ",
+ "WHERE ", exptype, "=", id)
+
+ if (db == "ecotox") {
+ expquery <- paste0(expquery, " AND type LIKE '", endpoint, "'")
+ }
+
+ expdata <- dbGetQuery(con, expquery)
+
+ if (db %in% c("cytotox", "enzymes")) {
+ controlquery <- paste0("SELECT type, response FROM controls ",
+ " WHERE plate=", id)
+ controldata <- dbGetQuery(con, controlquery)
+ }
+
+ op <- par(ask=TRUE)
+ on.exit(par(op))
+
+ 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 {
+ # Use raw response for ecotox
+ expdata$response <- expdata$raw_response
+
+ if (nlevels(expdata$type) > 1) {
+ message("There are data for more than one type of raw response in your data.\n",
+ "The types are ", paste(levels(expdata$type), collapse = " and "), ".\n",
+ "You should choose one of these types using 'endpoint = \"$type\"'",
+ "in your call to checkexperiment\n",
+ "For now, we are continuing with the data for ", levels(expdata$type)[1])
}
-
- # Plot of dose response data
- drdata <- expdata[c(2,4,6)]
- drdata$substance <- factor(drdata$substance)
- substances <- levels(drdata$substance)
-
- lld <- log10(min(subset(drdata,conc!=0)$conc))
- lhd <- log10(max(drdata$conc))
-
- ylab <- if (db == "ecotox") endpoint
- else responsename
-
- plot(1,type="n",
- xlim = c(lld - 0.5, lhd + 2),
- ylim = range(expdata[responsename], na.rm = TRUE),
- xlab = paste("decadic logarithm of the concentration in ",levels(expdata$unit)),
- ylab = ylab)
-
- drdatalist <- split(drdata,drdata$substance)
-
- for (i in 1:length(drdatalist)) {
- points(log10(drdatalist[[i]]$conc),drdatalist[[i]][[responsename]],col=i);
+ endpoint <- expdata$type[1]
+ expdata <- subset(expdata, type == endpoint)
+
+ controls <- subset(expdata, conc == 0)
+ expdata <- 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") {
+ if (identical(as.character(levels(expdata$organism)), "Vibrio fischeri")) {
+ positive <- subset(expdata, substance == "Na Cl")
+ if (nrow(positive) > 0) {
+ QA <- rbind(QA,
+ c(nrow(positive),
+ signif(mean(positive$raw_response), 2),
+ signif(sd(positive$raw_response), 2),
+ signif(100 * sd(positive$raw_response) /
+ mean(positive$raw_response), 2)))
+
+ rownames(QA) <- c("Control (conc = 0)",
+ "Positive control (Na Cl)")
+ }
+ expdata <- subset(expdata, substance != "Na Cl", drop = TRUE)
}
-
- legend("topright",substances, pch=1, col=1:length(substances), inset=0.05)
- title(main=paste(levels(expdata$experimentator),
- " - ",levels(expdata$type)))
+ }
+
+ if (length(expdata$experimentator) < 1) {
+ stop("There is no response data for ", exptype, " ",
+ id, " in database ", db, "\n")
+ }
+ exptypestring <- paste0(toupper(substring(exptype, 1, 1)),
+ substring(exptype, 2))
+ expdata$experimentator <- factor(expdata$experimentator)
+ expdata$type <- factor(expdata[[testtype]])
+ expdata$performed <- factor(as.character(expdata$performed))
+ expdata$substance <- factor(expdata$substance)
+ expdata$unit <- factor(expdata$unit)
+ expdata$ok <- factor(expdata$ok)
+
+ # Info on the experiment
+ cat("\n",
+ exptypestring, id, "from database", db, ":\n\n",
+ "\tExperimentator(s):\t",levels(expdata$experimentator),"\n",
+ "\tType(s):\t\t",levels(expdata$type),"\n",
+ "\tPerformed on:\t\t",levels(expdata$performed),"\n",
+ "\tSubstance(s):\t\t",levels(expdata$substance),"\n",
+ "\tConcentration unit(s):\t",levels(expdata$unit),"\n",
+ "\tComment:\t\t",comment,"\n",
+ "\tOK Levels:\t\t",levels(expdata$ok),"\n\n")
+
+ print(QA)
+
+ # Control growth rate for Lemna and algae
+ if (endpoint %in% c("cell count", "frond area", "frond number")) {
+ duration <- as.numeric(unique(expdata$duration)) # in hours
+ if (length(duration) > 1) stop("More than one duration in the data")
+ response_0 <- unique(expdata$raw_0)
+ if (length(response_0) > 1) stop("More than one mean response at time 0 in the data")
+ t_days <- duration / 24
+ control_growth_rates <- (log(controls$response) - log(response_0)) / t_days
+ cat("\nMean growth rate in controls:\t", round(mean(control_growth_rates), 3), "per day\n")
+ }
+
+ # Box plot of control data
+ if (db == "ecotox") {
+ boxplot(controls$response,
+ names="controls",
+ ylab=endpoint,
+ ylim=range(controls$response, na.rm = TRUE),
+ boxwex=0.4,
+ main=paste("Plate ",id))
+ } else {
+ boxplot(blinds$response,controls$response,
+ names=c("blinds","controls"),
+ ylab="Response",
+ boxwex=0.4,
+ main=paste("Plate ",id))
+ }
+
+ # Plot of dose response data
+ drdata <- expdata[c(2,4,6)]
+ drdata$substance <- factor(drdata$substance)
+ substances <- levels(drdata$substance)
+
+ lld <- log10(min(subset(drdata,conc!=0)$conc))
+ lhd <- log10(max(drdata$conc))
+
+ ylab <- if (db == "ecotox") endpoint
+ else responsename
+
+ plot(1,type="n",
+ xlim = c(lld - 0.5, lhd + 2),
+ ylim = range(expdata[responsename], na.rm = TRUE),
+ xlab = paste("decadic logarithm of the concentration in ",levels(expdata$unit)),
+ ylab = ylab)
+
+ drdatalist <- split(drdata,drdata$substance)
+
+ for (i in 1:length(drdatalist)) {
+ points(log10(drdatalist[[i]]$conc),drdatalist[[i]][[responsename]],col=i);
+ }
+
+ legend("topright",substances, pch=1, col=1:length(substances), inset=0.05)
+ title(main=paste(levels(expdata$experimentator),
+ " - ",levels(expdata$type)))
}
diff --git a/R/checkplate.R b/R/checkplate.R
index 0a56e44..1421179 100644
--- a/R/checkplate.R
+++ b/R/checkplate.R
@@ -1,4 +1,4 @@
-checkplate <- function(id, db = "cytotox")
+checkplate <- function(id, db = c("cytotox", "enzymes"))
{
- checkexperiment(id, db = db)
+ checkexperiment(id, db = db)
}
diff --git a/R/checksubstance.R b/R/checksubstance.R
index f22d4e2..e74ad21 100644
--- a/R/checksubstance.R
+++ b/R/checksubstance.R
@@ -1,97 +1,95 @@
-checksubstance <- function(substance, db = "cytotox", experimentator = "%",
- celltype = "%", enzymetype = "%", organism = "%",
- endpoint = "%",
- whereClause = "1", ok= "%")
+checksubstance <- function(substance,
+ db = c("cytotox", "enzymes", "ecotox"),
+ experimentator = "%",
+ celltype = "%", enzymetype = "%", organism = "%",
+ endpoint = "%",
+ whereClause = "1", ok= "%")
{
- databases <- data.frame(
- responsename=c("viability","activity","response"),
- testtype=c("celltype","enzyme","organism"),
- exptype=c("plate","plate","experiment"))
- rownames(databases) <- c("cytotox","enzymes","ecotox")
+ db = match.arg(db)
- if (!(db %in% rownames(databases))) stop("Database is not supported")
+ databases <- data.frame(
+ responsename = c("viability", "activity", "raw_response"),
+ testtype = c("celltype", "enzyme", "organism"),
+ exptype = c("plate", "plate", "experiment"),
+ row.names = c("cytotox", "enzymes", "ecotox"),
+ stringsAsFactors = FALSE)
- 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.")
- }
+ con <- dbConnect(odbc(), "cytotox", database = db)
- responsename = as.character(databases[db,1])
- testtype = as.character(databases[db,2])
- exptype = as.character(databases[db,3])
+ responsename <- databases[db, 1]
+ testtype <- databases[db, 2]
+ exptype <- databases[db, 3]
- if (db == "cytotox") {
- type <- celltype
- }
- if (db == "enzymes") {
- type <- enzymetype
- }
- if (db == "ecotox") {
- type <- organism
- }
+ if (db == "cytotox") {
+ type <- celltype
+ }
+ if (db == "enzymes") {
+ type <- enzymetype
+ }
+ if (db == "ecotox") {
+ type <- organism
+ }
- query <- paste("SELECT experimentator,substance,",
- testtype, ",", exptype, ",conc,unit,",responsename,",ok",
- " FROM ",db," WHERE substance LIKE '",
- substance,"' AND experimentator LIKE '",
- experimentator,"' AND ",testtype," LIKE '",
- type,"' AND ",
- whereClause," AND ok LIKE '",ok,"'",
- sep = "")
+ query <- paste("SELECT experimentator,substance,",
+ testtype, ",", exptype, ",conc,unit,",responsename,",ok",
+ " FROM ",db," WHERE substance LIKE '",
+ substance,"' AND experimentator LIKE '",
+ experimentator,"' AND ",testtype," LIKE '",
+ type,"' AND ",
+ whereClause," AND ok LIKE '",ok,"'",
+ sep = "")
- if (db == "ecotox") {
- query <- paste(query, " AND type LIKE '",
- endpoint, "'", sep = "")
- }
+ if (db == "ecotox") {
+ query <- paste(query, " AND type LIKE '",
+ endpoint, "'", sep = "")
+ }
- data <- RODBC::sqlQuery(channel,query)
- RODBC::odbcClose(channel)
+ data <- dbGetQuery(con, query)
- if (length(data$experimentator) < 1) {
- stop(paste("\nNo response data for",substance,"in database",
- db,"found with these parameters\n"))
- }
+ if (length(data$experimentator) < 1) {
+ stop(paste("\nNo response data for",substance,"in database",
+ db,"found with these parameters\n"))
+ }
- data$experimentator <- factor(data$experimentator)
- data$substance <- factor(data$substance)
- substances <- levels(data$substance)
- data$type <- factor(data[[testtype]])
- data[[exptype]] <- factor(data[[exptype]])
- experiments <- levels(data[[exptype]])
- concentrations <- split(data$conc,data$conc)
- concentrations <- as.numeric(names(concentrations))
- data$unit <- factor(data$unit)
- data$ok <- factor(data$ok)
+ data$experimentator <- factor(data$experimentator)
+ data$substance <- factor(data$substance)
+ substances <- levels(data$substance)
+ data$type <- factor(data[[testtype]])
+ data[[exptype]] <- factor(data[[exptype]])
+ experiments <- levels(data[[exptype]])
+ concentrations <- split(data$conc,data$conc)
+ concentrations <- as.numeric(names(concentrations))
+ data$unit <- factor(data$unit)
+ data$ok <- factor(data$ok)
- if (length(experiments)>6) {
- palette(rainbow(length(experiments)))
- }
+ if (length(experiments)>6) {
+ palette(rainbow(length(experiments)))
+ }
- plot(log10(data$conc),data[[responsename]],
- xlim=c(-2.5, 4.5),
- ylim= range(data[[responsename]], na.rm = TRUE),
- xlab=paste("decadic logarithm of the concentration in ",levels(data$unit)),
- ylab=responsename)
+ plot(log10(data$conc),data[[responsename]],
+ xlim=c(-2.5, 4.5),
+ ylim= range(data[[responsename]], na.rm = TRUE),
+ xlab=paste("decadic logarithm of the concentration in ",levels(data$unit)),
+ ylab=responsename)
- explist <- split(data,data[[exptype]])
+ explist <- split(data,data[[exptype]])
- for (i in 1:length(explist)) {
- points(log10(explist[[i]]$conc),explist[[i]][[responsename]],col=i);
- }
+ for (i in 1:length(explist)) {
+ points(log10(explist[[i]]$conc),explist[[i]][[responsename]],col=i);
+ }
- legend("topleft", experiments, pch=1, col=1:length(experiments), inset=0.05)
- title(main=paste(substance," - ",levels(data$experimentator)," - ",levels(data$type)))
+ legend("topleft", experiments, pch=1, col=1:length(experiments), inset=0.05)
+ title(main=paste(substance," - ",levels(data$experimentator)," - ",levels(data$type)))
- exptypename <- paste(toupper(substring(exptype,1,1)),
- substring(exptype,2), sep = "")
- experimentators <- paste(levels(data$experimentator), collapse = " ")
- types <- paste(levels(data$type), collapse = " ")
- experiments <- paste(levels(data[[exptype]]), collapse = " ")
- class(experiments)
- cat("\n\tSubstanz:\t\t",substance,"\n",
- "\tExperimentator(s):\t", experimentators,"\n",
- "\tType(s): \t\t",types,"\n",
- "\tEndpoint: \t\t",endpoint,"\n",
- "\t", exptypename, "(s):\t\t",experiments,"\n\n", sep = "")
+ exptypename <- paste(toupper(substring(exptype,1,1)),
+ substring(exptype,2), sep = "")
+ experimentators <- paste(levels(data$experimentator), collapse = " ")
+ types <- paste(levels(data$type), collapse = " ")
+ experiments <- paste(levels(data[[exptype]]), collapse = " ")
+ class(experiments)
+ cat("\n\tSubstanz:\t\t",substance,"\n",
+ "\tExperimentator(s):\t", experimentators,"\n",
+ "\tType(s): \t\t",types,"\n",
+ "\tEndpoint: \t\t",endpoint,"\n",
+ "\t", exptypename, "(s):\t\t",experiments,"\n\n", sep = "")
}
diff --git a/R/drdata.R b/R/drdata.R
index b7e4761..8f18ebd 100644
--- a/R/drdata.R
+++ b/R/drdata.R
@@ -3,44 +3,50 @@ drdata <- function(substances, experimentator = "%", db = "cytotox",
organism = "Vibrio fischeri", endpoint = "Luminescence", whereClause = "1",
ok = "'ok','no fit'")
{
- if (requireNamespace("RODBC")) {
- channel <- RODBC::odbcConnect(db,uid="cytotox",pwd="cytotox",case="tolower")
- slist <- paste(substances,collapse="','")
- if (db == "cytotox") {
- experimenttype <- "plate"
- responsetype <- "viability"
- testtype <- "celltype"
- type <- celltype
- } else {
- if (db == "enzymes") {
- experimenttype <- "plate"
- responsetype <- "activity"
- testtype <- "enzyme"
- type <- enzymetype
- } else {
- experimenttype <- "experiment"
- responsetype <- "response"
- testtype <- "organism"
- type <- organism
- }
- }
+ # Connect to the correct database via the DSN
+ con <- dbConnect(odbc(), "cytotox", database = db)
- query <- paste("SELECT conc,",responsetype,", unit, experimentator, ",
- experimenttype, ", substance, ", testtype,
- ", ok FROM ", db, " WHERE substance IN ('",
- slist,"') AND experimentator LIKE '",
- experimentator,"' AND ",testtype," LIKE '",
- type,"' AND ",
- whereClause," AND ok in (",
- ok,")",sep="")
- if (db == "ecotox") query <- paste(query," AND type LIKE '",endpoint,"'",sep="")
- data <- RODBC::sqlQuery(channel,query)
- RODBC::odbcClose(channel)
- names(data)[[1]] <- "dose"
- names(data)[[2]] <- "response"
- data$substance <- factor(data$substance,levels=substances)
- return(data)
+ # Construct the query
+ slist <- paste(substances, collapse = "','")
+ if (db == "cytotox") {
+ experimenttype <- "plate"
+ responsetype <- "viability"
+ testtype <- "celltype"
+ type <- celltype
} else {
- stop("For this function, the RODBC package has to be installed and configured.")
+ if (db == "enzymes") {
+ experimenttype <- "plate"
+ responsetype <- "activity"
+ testtype <- "enzyme"
+ type <- enzymetype
+ } else {
+ experimenttype <- "experiment"
+ responsetype <- "response"
+ testtype <- "organism"
+ type <- organism
+ }
}
+
+ query <- paste0(
+ "SELECT conc,", responsetype, ", unit, experimentator, ",
+ experimenttype, ", substance, ", testtype,
+ ", ok ",
+ "FROM ", db, " ",
+ "WHERE ",
+ "substance IN ('", slist, "') AND ",
+ "experimentator LIKE '", experimentator,"' AND ",
+ testtype, " LIKE '", type, "' AND ",
+ whereClause, " AND ",
+ "ok in (", ok, ")")
+
+ if (db == "ecotox") query <- paste0(query, " AND type LIKE '", endpoint, "'")
+
+ # Get the data, format and return them
+ data <- dbGetQuery(con, query)
+
+ names(data)[[1]] <- "dose"
+ names(data)[[2]] <- "response"
+ data$substance <- factor(data$substance, levels = substances)
+
+ return(data)
}

Contact - Imprint