diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/checkexperiment.R | 41 | ||||
| -rw-r--r-- | R/checkplate.R | 4 | ||||
| -rw-r--r-- | R/checksubstance.R | 86 | ||||
| -rw-r--r-- | R/drplot.R | 36 |
4 files changed, 109 insertions, 58 deletions
diff --git a/R/checkexperiment.R b/R/checkexperiment.R index 3078ca5..941856b 100644 --- a/R/checkexperiment.R +++ b/R/checkexperiment.R @@ -1,23 +1,29 @@ -checkexperiment <- function(id,db="ecotox") +checkexperiment <- function(id, db = "ecotox", endpoint = "%") { databases <- data.frame( - responsetype=c("viability","activity","response"), + responsename=c("viability","activity","response"), testtype=c("celltype","enzyme","organism"), exptype=c("plate","plate","experiment")) rownames(databases) <- c("cytotox","enzymes","ecotox") - if (!(db %in% rownames(databases))) stop("Database does not exist") + if (!(db %in% rownames(databases))) stop("Database is not supported") library(RODBC) channel <- odbcConnect(db,uid="cytotox",pwd="cytotox",case="tolower") - responsetype = as.character(databases[db,1]) + responsename = as.character(databases[db,1]) testtype = as.character(databases[db,2]) exptype = as.character(databases[db,3]) - expquery <- paste("SELECT experimentator,substance,", - testtype,",conc,unit,",responsetype,",performed,ok", - "FROM ",db," WHERE ",exptype,"=", id) + expquery <- paste("SELECT experimentator,substance, ", + testtype, ",conc,unit,", responsename, ",performed,ok", + " FROM ",db," WHERE ",exptype,"=", id, + sep = "") + + if (db == "ecotox") { + expquery <- paste(expquery, " AND type LIKE '", + endpoint, "'", sep = "") + } expdata <- sqlQuery(channel,expquery) @@ -57,10 +63,13 @@ checkexperiment <- function(id,db="ecotox") meanOfControls <- stdOfControls <- percentstdOfcontrols <- NA } + 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)) @@ -68,13 +77,13 @@ checkexperiment <- function(id,db="ecotox") expdata$unit <- factor(expdata$unit) expdata$ok <- factor(expdata$ok) - cat("\n",exptype," ",id," from database ",db,"\n", - "\tExperimentator(s): ",levels(expdata$experimentator),"\n", - "\tType(s): ",levels(expdata$type),"\n", - "\tPerformed on: ",levels(expdata$performed),"\n", - "\tSubstance(s): ",levels(expdata$substance),"\n", - "\tConcentration unit(s): ",levels(expdata$unit),"\n", - "\tOK: ",levels(expdata$ok),"\n", + 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", + "\tOK:\t\t\t",levels(expdata$ok),"\n", "\t\tNumber \tMean \tStd. Dev. \t% Std. Dev.\n", "\tblind\t",numberOfBlinds,"\t",meanOfBlinds,"\t",stdOfBlinds,"\n", "\tcontrol\t",numberOfControls,"\t",meanOfControls,"\t", @@ -107,12 +116,12 @@ checkexperiment <- function(id,db="ecotox") xlim=c(lld - 0.5, lhd + 2), ylim= c(-0.1, 2), xlab=paste("decadic logarithm of the concentration in ",levels(expdata$unit)), - ylab=responsetype) + ylab=responsename) drdatalist <- split(drdata,drdata$substance) for (i in 1:length(drdatalist)) { - points(log10(drdatalist[[i]]$conc),drdatalist[[i]][[responsetype]],col=i); + points(log10(drdatalist[[i]]$conc),drdatalist[[i]][[responsename]],col=i); } legend("topright",substances, pch=1, col=1:length(substances), inset=0.05) diff --git a/R/checkplate.R b/R/checkplate.R index e03be70..0a56e44 100644 --- a/R/checkplate.R +++ b/R/checkplate.R @@ -1,4 +1,4 @@ -checkplate <- function(id,db="cytotox") +checkplate <- function(id, db = "cytotox") { - checkexperiment(id,db=db) + checkexperiment(id, db = db) } diff --git a/R/checksubstance.R b/R/checksubstance.R index 986edda..96be999 100644 --- a/R/checksubstance.R +++ b/R/checksubstance.R @@ -1,60 +1,94 @@ -checksubstance <- function(substance,db="cytotox",experimentator="%",celltype="%",enzymetype="%",whereClause="1",ok="%") +checksubstance <- function(substance, db = "cytotox", 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") + + if (!(db %in% rownames(databases))) stop("Database is not supported") + library(RODBC) channel <- odbcConnect(db,uid="cytotox",pwd="cytotox",case="tolower") + responsename = as.character(databases[db,1]) + testtype = as.character(databases[db,2]) + exptype = as.character(databases[db,3]) + if (db == "cytotox") { - responsetype <- "viability" - testtype <- "celltype" type <- celltype - } else { - responsetype <- "activity" - testtype <- "enzyme" + } + if (db == "enzymes") { type <- enzymetype - } - query <- paste("SELECT experimentator,substance,",testtype,",plate,conc,unit,",responsetype,",ok", + } + 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="") + whereClause," AND ok LIKE '",ok,"'", + sep = "") + + if (db == "ecotox") { + query <- paste(query, " AND type LIKE '", + endpoint, "'", sep = "") + } data <- sqlQuery(channel,query) odbcClose(channel) + + 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$plate <- factor(data$plate) - plates <- levels(data$plate) + 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(plates)>6) { - palette(rainbow(length(plates))) + + if (length(experiments)>6) { + palette(rainbow(length(experiments))) } - plot(log10(data$conc),data[[responsetype]], + plot(log10(data$conc),data[[responsename]], xlim=c(-2.5, 4.5), ylim= c(-0.1, 2), xlab=paste("decadic logarithm of the concentration in ",levels(data$unit)), - ylab=responsetype) + ylab=responsename) - platelist <- split(data,data$plate) + explist <- split(data,data[[exptype]]) - for (i in 1:length(platelist)) { - points(log10(platelist[[i]]$conc),platelist[[i]][[responsetype]],col=i); + for (i in 1:length(explist)) { + points(log10(explist[[i]]$conc),explist[[i]][[responsename]],col=i); } - legend("topleft", plates, pch=1, col=1:length(plates), inset=0.05) + legend("topleft", experiments, pch=1, col=1:length(experiments), inset=0.05) title(main=paste(substance," - ",levels(data$experimentator)," - ",levels(data$type))) - - cat("Substanz ",substance,"\n", - "\tExperimentator(s):",levels(data$experimentator),"\n", - "\tType(s):\t",levels(data$type),"\n", - "\tSubstance(s):\t",levels(data$substance),"\n", - "\tPlate(s):\t",plates,"\n\n") + + 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 = "") } @@ -2,10 +2,12 @@ drplot <- function(drresults, data, dtype = "std", alpha = 0.95, ctype = "none", path = "./", fileprefix = "drplot", overlay = FALSE, xlim = c("auto","auto"), ylim = c("auto","auto"), + xlab = paste("Decadic Logarithm of the dose in ", unit), + ylab = "Normalized response", postscript = FALSE, pdf = FALSE, png = FALSE, bw = TRUE, pointsize = 12, - colors = 1:8, devoff=T, lpos="topright") + colors = 1:8, ltys = 1:8, devoff=T, lpos="topright") { # Check if all data have the same unit unitlevels <- levels(as.factor(drresults$unit)) @@ -81,8 +83,8 @@ drplot <- function(drresults, data, plot(0,type="n", xlim = xlim, ylim = ylim, - xlab = paste("Decadic Logarithm of the dose in ", unit), - ylab = "Normalized response") + xlab = xlab, + ylab = ylab) } else { # If overlay plot is not requested, ask before showing multiple plots on the screen if (!postscript && !png && !pdf && length(dsubstances) > 1) { @@ -90,6 +92,8 @@ drplot <- function(drresults, data, on.exit(par(op)) } } + # nl is the overall number of fits to draw by different line types + nl <- 0 # Plot the data either as raw data or as error bars if(is.data.frame(data)) { @@ -97,7 +101,7 @@ drplot <- function(drresults, data, # n is the index for the dose-response curves n <- 0 if (bw) colors <- rep("black",length(dsubstances)) - # Loop over the substances in the data + # Loop over the substances in the data (index n) for (i in dsubstances) { n <- n + 1 tmp <- splitted[[i]] @@ -128,10 +132,10 @@ drplot <- function(drresults, data, plot(0,type="n", xlim = xlim, ylim = ylim, - xlab = paste("Decadic Logarithm of the dose in ", unit), - ylab = "Normalized response") + xlab = xlab, + ylab = ylab) } - if (!overlay) legend(lpos, i,lty = 1, col = color, inset=0.05) + if (!overlay) legend(lpos, i, lty = 1, col = color, inset=0.05) tmp$dosefactor <- factor(tmp$dose) # necessary because the old # factor has all levels, not # only the ones tested with @@ -180,31 +184,35 @@ drplot <- function(drresults, data, } } - # Plot the fits, if there are any + # Plot the fits for this substance, if there are any fits <- subset(drresults,Substance == i) - nf <- length(fits$Substance) # number of fits to plot + nf <- length(fits$Substance) # number of fits to plot for this substance if (nf > 0) { for (j in 1:nf) { logED50 <- fits[j,"logED50"] mtype <- as.character(fits[j, "mtype"]) if (mtype == "probit") { + lty <- ltys[nl <- nl + 1] scale <- fits[j,"b"] - plot(function(x) pnorm(-x,-logED50,scale),lld - 0.5, lhd + 2, add=TRUE,col=color) + plot(function(x) pnorm(-x,-logED50,scale),lld - 0.5, lhd + 2, add=TRUE, col=color, lty=lty) } if (mtype == "logit") { + lty <- ltys[nl <- nl + 1] scale <- fits[j,"b"] - plot(function(x) plogis(-x,-logED50,scale),lld - 0.5, lhd + 2, add=TRUE,col=color) + plot(function(x) plogis(-x,-logED50,scale),lld - 0.5, lhd + 2, add=TRUE, col=color, lty=lty) } if (mtype == "weibull") { + lty <- ltys[nl <- nl + 1] location <- fits[j,"a"] shape <- fits[j,"b"] - plot(function(x) pweibull(-x+location,shape),lld - 0.5, lhd + 2, add=TRUE,col=color) + plot(function(x) pweibull(-x+location,shape),lld - 0.5, lhd + 2, add=TRUE, col=color, lty=lty) } if (mtype == "linlogit") { + lty <- ltys[nl <- nl + 1] plot(function(x) linlogitf(10^x,1,fits[j,"c"],fits[j,"logED50"],fits[j,"b"]), lld - 0.5, lhd + 2, - add=TRUE,col=color) + add=TRUE, col=color, lty=lty) } } } @@ -214,7 +222,7 @@ drplot <- function(drresults, data, } } } - if (overlay) legend(lpos, dsubstances,lty = 1, col = colors, inset=0.05) + if (overlay) legend(lpos, dsubstances, col = colors, lty = ltys, inset=0.05) if (overlay && (postscript || png || pdf)) { if (devoff) { dev.off() |