diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/checkcontrols.R | 243 | ||||
| -rw-r--r-- | R/checkexperiment.R | 371 | ||||
| -rw-r--r-- | R/checkplate.R | 4 | ||||
| -rw-r--r-- | R/checksubstance.R | 158 | ||||
| -rw-r--r-- | R/drdata.R | 80 |
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 = "") } @@ -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) } |