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