diff options
| -rw-r--r-- | DESCRIPTION | 15 | ||||
| -rw-r--r-- | NAMESPACE | 5 | ||||
| -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 | ||||
| -rw-r--r-- | check.log | 75 | ||||
| -rw-r--r-- | man/XY.Rd | 3 | ||||
| -rw-r--r-- | man/antifoul.Rd | 3 | ||||
| -rw-r--r-- | man/checkcontrols.Rd | 4 | ||||
| -rw-r--r-- | man/checkexperiment.Rd | 5 | ||||
| -rw-r--r-- | man/checksubstance.Rd | 5 | ||||
| -rw-r--r-- | man/drcfit.Rd | 1 | ||||
| -rw-r--r-- | man/drdata.Rd | 16 | ||||
| -rw-r--r-- | man/drfit.Rd | 1 | ||||
| -rw-r--r-- | man/drplot.Rd | 1 | ||||
| -rw-r--r-- | man/linlogitf.Rd | 1 |
18 files changed, 500 insertions, 491 deletions
diff --git a/DESCRIPTION b/DESCRIPTION index 4153556..7486b7e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,11 +1,12 @@ Package: drfit -Version: 0.7.1 -Date: 2017-07-18 +Version: 0.7.2 +Date: 2018-09-15 Title: Dose-Response Data Evaluation -Authors@R: person("Johannes", "Ranke", role = c("aut", "cre"), - email = "jranke@uni-bremen.de", - comment = c(ORCID = "0000-0003-4371-6538")) -Imports: graphics, grDevices, MASS, drc, reshape2, qcc, RODBC +Authors@R: person("Johannes", "Ranke", email = "jranke@uni-bremen.de", + role = c("aut", "cre"), + comment = c(ORCID = "0000-0003-4371-6538")) +Depends: R (>= 2.15.1) +Imports: graphics, grDevices, MASS, drc, reshape2, qcc, odbc, DBI Description: A somewhat outdated package of basic and easy-to-use functions for fitting dose-response curves to continuous dose-response data, calculating some toxicological parameters and plotting the results. Please consider using @@ -15,7 +16,7 @@ Description: A somewhat outdated package of basic and easy-to-use functions for distribution ('weibull' fit) and a linear-logistic model ('linlogit' fit), derived from the latter, which is used to describe data showing stimulation at low doses (hormesis). In addition, functions checking, plotting and retrieving - dose-response data retrieved from a database accessed via 'RODBC' are included. + dose-response data retrieved from a database accessed via 'odbc' are included. As an alternative to the original fitting methods, the algorithms from the 'drc' package can be used. Encoding: UTF-8 @@ -4,11 +4,12 @@ import( graphics, grDevices, stats, - MASS, - RODBC + MASS ) importFrom("drc", drm, ED, LN.2, LL.2, BC.4, W1.2) importFrom("utils", "packageVersion") importFrom("qcc", qcc) importFrom("reshape2", melt, acast) +importFrom("odbc", odbc) +importFrom("DBI", dbConnect, dbGetQuery) 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) } @@ -1,13 +1,15 @@ -* using log directory ‘/home/jranke/git/drfit/drfit.Rcheck’ -* using R version 3.4.1 (2017-06-30) -* using platform: x86_64-pc-linux-gnu (64-bit) -* using session charset: UTF-8 -* using option ‘--as-cran’ -* checking for file ‘drfit/DESCRIPTION’ ... OK -* this is package ‘drfit’ version ‘0.7.1’ +* using log directory 'C:/Users/johannes/git/drfit/drfit.Rcheck' +* using R version 3.5.1 (2018-07-02) +* using platform: i386-w64-mingw32 (32-bit) +* using session charset: ISO8859-1 +* using option '--as-cran' +* checking for file 'drfit/DESCRIPTION' ... OK +* this is package 'drfit' version '0.7.2' * package encoding: UTF-8 -* checking CRAN incoming feasibility ... Note_to_CRAN_maintainers -Maintainer: ‘Johannes Ranke <jranke@uni-bremen.de>’ +* checking CRAN incoming feasibility ... NOTE +Maintainer: 'Johannes Ranke <jranke@uni-bremen.de>' + +The Date field is over a month old. * checking package namespace information ... OK * checking package dependencies ... OK * checking if this is a source package ... OK @@ -15,12 +17,13 @@ Maintainer: ‘Johannes Ranke <jranke@uni-bremen.de>’ * checking for executable files ... OK * checking for hidden files and directories ... OK * checking for portable file names ... OK -* checking for sufficient/correct file permissions ... OK -* checking whether package ‘drfit’ can be installed ... OK +* checking serialization versions ... OK +* checking whether package 'drfit' can be installed ... OK * checking installed package size ... OK * checking package directory ... OK * checking DESCRIPTION meta-information ... OK -* checking top-level files ... OK +* checking top-level files ... NOTE +Files 'README.md' or 'NEWS.md' cannot be checked without 'pandoc' being installed. * checking for left-over files ... OK * checking index information ... OK * checking package subdirectories ... OK @@ -31,7 +34,6 @@ Maintainer: ‘Johannes Ranke <jranke@uni-bremen.de>’ * checking whether the package can be unloaded cleanly ... OK * checking whether the namespace can be loaded with stated dependencies ... OK * checking whether the namespace can be unloaded cleanly ... OK -* checking loading without being on the library search path ... OK * checking use of S3 registration ... OK * checking dependencies in R code ... OK * checking S3 generic/method consistency ... OK @@ -47,27 +49,42 @@ Maintainer: ‘Johannes Ranke <jranke@uni-bremen.de>’ * checking Rd \usage sections ... OK * checking Rd contents ... OK * checking for unstated dependencies in examples ... OK -* checking contents of ‘data’ directory ... OK +* checking contents of 'data' directory ... OK * checking data for non-ASCII characters ... OK * checking data for ASCII and uncompressed saves ... OK -* checking sizes of PDF files under ‘inst/doc’ ... OK -* checking installed files from ‘inst/doc’ ... OK + WARNING +'qpdf' is needed for checks on size reduction of PDFs +* checking installed files from 'inst/doc' ... OK * checking examples ... OK -* checking for unstated dependencies in ‘tests’ ... OK +* checking for unstated dependencies in 'tests' ... OK * checking tests ... - Running ‘IM1xIPC81.R’ - Comparing ‘IM1xIPC81.Rout’ to ‘IM1xIPC81.Rout.save’ ... OK - Running ‘IM1xVibrio.R’ - Comparing ‘IM1xVibrio.Rout’ to ‘IM1xVibrio.Rout.save’ ... OK - Running ‘XY.R’ - Comparing ‘XY.Rout’ to ‘XY.Rout.save’ ... OK - Running ‘antifoul.R’ - Comparing ‘antifoul.Rout’ to ‘antifoul.Rout.save’ ... OK - Running ‘pyrithione.R’ - Comparing ‘pyrithione.Rout’ to ‘pyrithione.Rout.save’ ... OK + Running 'IM1xIPC81.R' + Comparing 'IM1xIPC81.Rout' to 'IM1xIPC81.Rout.save' ... OK + Running 'IM1xVibrio.R' + Comparing 'IM1xVibrio.Rout' to 'IM1xVibrio.Rout.save' ... OK + Running 'XY.R' + Comparing 'XY.Rout' to 'XY.Rout.save' ... OK + Running 'antifoul.R' + Comparing 'antifoul.Rout' to 'antifoul.Rout.save' ... OK + Running 'pyrithione.R' + Comparing 'pyrithione.Rout' to 'pyrithione.Rout.save' ... OK OK -* checking PDF version of manual ... OK +* checking PDF version of manual ... WARNING +LaTeX errors when creating PDF version. +This typically indicates Rd problems. +* checking PDF version of manual without hyperrefs or index ... ERROR +Re-running with no redirection of stdout/stderr. +Hmm ... looks like a package +Error in texi2dvi(file = file, pdf = TRUE, clean = clean, quiet = quiet, : + pdflatex is not available +Error in texi2dvi(file = file, pdf = TRUE, clean = clean, quiet = quiet, : + pdflatex is not available +Error in running tools::texi2pdf() +You may want to clean up by 'rm -Rf C:/Users/johannes/AppData/Local/Temp/RtmpAdBCqG/Rd2pdfee0141549db' * DONE -Status: OK +Status: 1 ERROR, 2 WARNINGs, 2 NOTEs +See + 'C:/Users/johannes/git/drfit/drfit.Rcheck/00check.log' +for details. @@ -14,7 +14,4 @@ \examples{ \dontrun{demo(XY)} } -\source{ - \url{http://www.uft.uni-bremen.de/chemie} -} \keyword{datasets} diff --git a/man/antifoul.Rd b/man/antifoul.Rd index e782636..7d814a6 100644 --- a/man/antifoul.Rd +++ b/man/antifoul.Rd @@ -28,7 +28,4 @@ rantifoul.drc <- drcfit(antifoul, print(rantifoul.drc, digits = 5) } -\source{ - \url{http://www.uft.uni-bremen.de/chemie} -} \keyword{datasets} diff --git a/man/checkcontrols.Rd b/man/checkcontrols.Rd index 91d2dff..d99c342 100644 --- a/man/checkcontrols.Rd +++ b/man/checkcontrols.Rd @@ -6,7 +6,8 @@ experiments from a specified database. } \usage{ - checkcontrols(last = 10, id = NULL, db = "cytotox", + checkcontrols(last = 10, id = NULL, + db = c("cytotox", "enzymes", "ecotox"), celltype = "IPC-81", enzymetype = "AChE", organism = "Vibrio fischeri", endpoint = "\%", qcc = c("R", "xbar")) @@ -54,6 +55,5 @@ \author{ Johannes Ranke \email{jranke@uni-bremen.de} - \url{http://www.uft.uni-bremen.de/chemie/ranke} } \keyword{database} diff --git a/man/checkexperiment.Rd b/man/checkexperiment.Rd index 6a682fa..9d365f8 100644 --- a/man/checkexperiment.Rd +++ b/man/checkexperiment.Rd @@ -7,8 +7,8 @@ specified database, box plot controls, and plot the dose-response data. } \usage{ - checkplate(id, db = "cytotox") - checkexperiment(id, db = "ecotox", endpoint = "\%") + checkplate(id, db = c("cytotox", "enzymes")) + checkexperiment(id, db = c("ecotox", "cytotox", "enzymes"), endpoint = "\%") } \arguments{ \item{id}{ @@ -31,6 +31,5 @@ \author{ Johannes Ranke \email{jranke@uni-bremen.de} - \url{http://www.uft.uni-bremen.de/chemie/ranke} } \keyword{database} diff --git a/man/checksubstance.Rd b/man/checksubstance.Rd index 284ee88..2e4d62d 100644 --- a/man/checksubstance.Rd +++ b/man/checksubstance.Rd @@ -6,7 +6,9 @@ the data. } \usage{ - checksubstance(substance, db = "cytotox", experimentator = "\%", + checksubstance(substance, + db = c("cytotox", "enzymes", "ecotox"), + experimentator = "\%", celltype = "\%", enzymetype = "\%", organism = "\%", endpoint = "\%", whereClause = "1", ok = "\%") @@ -52,7 +54,6 @@ \author{ Johannes Ranke \email{jranke@uni-bremen.de} - \url{http://www.uft.uni-bremen.de/chemie/ranke} } \keyword{database} \keyword{internal} diff --git a/man/drcfit.Rd b/man/drcfit.Rd index 67462ba..db84875 100644 --- a/man/drcfit.Rd +++ b/man/drcfit.Rd @@ -148,7 +148,6 @@ format(r, digits = 2) } \author{ Johannes Ranke \email{jranke@uni-bremen.de} - \url{http://www.uft.uni-bremen.de/chemie/ranke} The functionality of the drc package used under the hood in this function was written by Christian Ritz. } diff --git a/man/drdata.Rd b/man/drdata.Rd index 2bb0b4d..3999fc6 100644 --- a/man/drdata.Rd +++ b/man/drdata.Rd @@ -5,8 +5,9 @@ Get dose-response data from an adequate ODBC data source } \usage{ - drdata(substances, experimentator = "\%", db = "cytotox", celltype = "IPC-81", - enzymetype="AChE", organism="Vibrio fischeri", endpoint="Luminescence", + drdata(substances, experimentator = "\%", db = "cytotox", + celltype = "IPC-81", enzymetype = "AChE", organism = "Vibrio fischeri", + endpoint = "Luminescence", whereClause = "1", ok = "'ok','no fit'") } \arguments{ @@ -78,14 +79,17 @@ } } \examples{ -# Get cytotoxicity data for Tributyltin and zinc pyrithione, tested with IPC-81 -# cells -\dontrun{drdata(c("TBT","ZnPT2"))} + \dontrun{ + + # Get cytotoxicity data for Tributyltin and zinc pyrithione, tested with IPC-81 + # cells + drdata(c("TBT", "ZnPT2")) + + } } \author{ Johannes Ranke \email{jranke@uni-bremen.de} - \url{http://www.uft.uni-bremen.de/chemie/ranke} } \keyword{IO} \keyword{database} diff --git a/man/drfit.Rd b/man/drfit.Rd index ec7fa70..b44a20f 100644 --- a/man/drfit.Rd +++ b/man/drfit.Rd @@ -177,7 +177,6 @@ format(r, digits = 2) \author{ Johannes Ranke \email{jranke@uni-bremen.de} - \url{http://www.uft.uni-bremen.de/chemie/ranke} } \keyword{models} \keyword{regression} diff --git a/man/drplot.Rd b/man/drplot.Rd index d8d7eb3..559ed8e 100644 --- a/man/drplot.Rd +++ b/man/drplot.Rd @@ -130,7 +130,6 @@ drplot(r,antifoul) \author{ Johannes Ranke \email{jranke@uni-bremen.de} - \url{http://www.uft.uni-bremen.de/chemie/ranke} } \keyword{models} \keyword{regression} diff --git a/man/linlogitf.Rd b/man/linlogitf.Rd index 2c9ddc4..a4360d6 100644 --- a/man/linlogitf.Rd +++ b/man/linlogitf.Rd @@ -29,7 +29,6 @@ \author{ Johannes Ranke \email{jranke@uni-bremen.de} - \url{http://www.uft.uni-bremen.de/chemie/ranke} } \keyword{models} \keyword{regression} |