From f6ca9cbb4b1ca8056cd9668760e8d55d638154aa Mon Sep 17 00:00:00 2001 From: ranke Date: Fri, 21 Apr 2006 21:28:41 +0000 Subject: Working version of the checkexperiment function, including documentation, but R CMD check tells me that "use of NULL environment is deprecated" git-svn-id: http://kriemhild.uft.uni-bremen.de/svn/drfit@66 d1b72e20-2ee0-0310-a1c4-ad5adbbefcdc --- R/checkexperiment.R | 82 ++++++++++++++++++++++++++++++++--------------------- R/checkplate.R | 81 ---------------------------------------------------- 2 files changed, 50 insertions(+), 113 deletions(-) delete mode 100644 R/checkplate.R (limited to 'R') diff --git a/R/checkexperiment.R b/R/checkexperiment.R index 68169c7..c29b1e5 100644 --- a/R/checkexperiment.R +++ b/R/checkexperiment.R @@ -1,4 +1,4 @@ -checkexperiment <- function(id,db="cytotox") +checkexperiment <- function(id,db="ecotox") { databases <- data.frame( responsetype=c("viability","activity","response"), @@ -34,15 +34,25 @@ checkexperiment <- function(id,db="cytotox") controls <- subset(controldata,type=="control") numberOfBlinds <- length(blinds$response) - stdOfBlinds <- sd(blinds$response) + meanOfBlinds <- signif(mean(blinds$response),2) + stdOfBlinds <- signif(sd(blinds$response),2) } else { controls <- subset(expdata,conc == 0) + expdata <- subset(expdata, conc != 0) numberOfBlinds <- NA + meanOfBlinds <- NA stdOfBlinds <- NA } - + numberOfControls <- length(controls$response) + if (numberOfControls > 0) { + meanOfControls <- signif(mean(controls$response),2) + stdOfControls <- signif(sd(controls$response),2) + percentstdOfcontrols <-signif(stdOfControls *100/meanOfControls,2) + } else { + meanOfControls <- stdOfControls <- percentstdOfcontrols <- NA + } if (length(expdata$experimentator) < 1) { stop("There is no response data for ",exptype," ", @@ -50,43 +60,51 @@ checkexperiment <- function(id,db="cytotox") } 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$performed <- factor(expdata$performed) expdata$ok <- factor(expdata$ok) - numberOfControls <- length(controls$response) - - meanOfBlinds <- mean(blinds$response) - meanOfControls <- mean(controls$response) - stdOfControls <- sd(controls$response) - percentstdOfcontrols <-stdOfControls *100/meanOfControls - - cat("Plate ",plate," from database ",db,"\n", - "\tExperimentator: ",levels(platedata$experimentator),"\n", - "\tType(s): ",levels(platedata$type),"\n", - "\tPerformed on : ",levels(platedata$performed),"\n", - "\tSubstance(s): ",levels(platedata$substance),"\n", - "\tConcentration unit: ",levels(platedata$unit),"\n", - "\tOK: ",levels(platedata$ok),"\n", - "\t\tNumber \tMean \t\tStandard Deviation \t% Standard Deviation \n", + 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", + "\t\tNumber \tMean \tStd. Dev. \t% Std. Dev.\n", "\tblind\t",numberOfBlinds,"\t",meanOfBlinds,"\t",stdOfBlinds,"\n", - "\tcontrol\t",numberOfControls,"\t",meanOfControls,"\t",stdOfControls,"\t\t",percentstdOfcontrols,"\n") + "\tcontrol\t",numberOfControls,"\t",meanOfControls,"\t", + stdOfControls,"\t\t",percentstdOfcontrols,"\n") - par(ask=TRUE) - - boxplot(blinds$response,controls$response, - names=c("blinds","controls"), - ylab="Response",main=paste("Plate ",plate)) + get(getOption("device"))(width=10,height=5) + par(mfcol=c(1,2)) + if (db == "ecotox") { + boxplot(controls$response, + names="controls", + ylab="Response", + ylim=c(0,max(controls$response)), + 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)) + } - drdata <- platedata[c(2,4,6)] + drdata <- expdata[c(2,4,6)] drdata$substance <- factor(drdata$substance) substances <- levels(drdata$substance) - plot(log10(drdata$conc),drdata$viability, - xlim=c(-2.5, 4.5), + lld <- log10(min(subset(drdata,conc!=0)$conc)) + lhd <- log10(max(drdata$conc)) + + plot(1,type="n", + xlim=c(lld - 0.5, lhd + 2), ylim= c(-0.1, 2), - xlab=paste("decadic logarithm of the concentration in ",levels(platedata$unit)), + xlab=paste("decadic logarithm of the concentration in ",levels(expdata$unit)), ylab=responsetype) drdatalist <- split(drdata,drdata$substance) @@ -95,7 +113,7 @@ checkexperiment <- function(id,db="cytotox") points(log10(drdatalist[[i]]$conc),drdatalist[[i]][[responsetype]],col=i); } - legend("topleft",substances, pch=1, col=1:length(substances), inset=0.05) - title(main=paste("Plate ",plate," - ", - levels(platedata$experimentator)," - ",levels(platedata$type))) + 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 deleted file mode 100644 index 46afc53..0000000 --- a/R/checkplate.R +++ /dev/null @@ -1,81 +0,0 @@ -checkplate <- function(plate,db="cytotox") -{ - library(RODBC) - channel <- odbcConnect(db,uid="cytotox",pwd="cytotox",case="tolower") - - if (db == "cytotox") { - responsetype <- "viability" - testtype <- "celltype" - } else { - responsetype <- "activity" - testtype <- "enzyme" - } - - platequery <- paste("SELECT experimentator,substance,",testtype,",conc,unit,",responsetype,",performed,ok", - "FROM ",db," WHERE plate=", plate) - - controlquery <- paste("SELECT type,response FROM controls WHERE plate=",plate) - - platedata <- sqlQuery(channel,platequery) - controldata <- sqlQuery(channel,controlquery) - - odbcClose(channel) - - if (length(platedata$experimentator) < 1) { - cat("There is no response data for plate ",plate," in database ",db,"\n") - } else { - platedata$experimentator <- factor(platedata$experimentator) - platedata$type <- factor(platedata[[testtype]]) - platedata$substance <- factor(platedata$substance) - platedata$unit <- factor(platedata$unit) - platedata$performed <- factor(platedata$performed) - platedata$ok <- factor(platedata$ok) - - blinds <- subset(controldata,type=="blind") - controls <- subset(controldata,type=="control") - - numberOfBlinds <- length(blinds$response) - numberOfControls <- length(controls$response) - meanOfBlinds <- mean(blinds$response) - meanOfControls <- mean(controls$response) - stdOfBlinds <- sd(blinds$response) - stdOfControls <- sd(controls$response) - percentstdOfcontrols <-stdOfControls *100/meanOfControls - - cat("Plate ",plate," from database ",db,"\n", - "\tExperimentator: ",levels(platedata$experimentator),"\n", - "\tType(s): ",levels(platedata$type),"\n", - "\tPerformed on : ",levels(platedata$performed),"\n", - "\tSubstance(s): ",levels(platedata$substance),"\n", - "\tConcentration unit: ",levels(platedata$unit),"\n", - "\tOK: ",levels(platedata$ok),"\n", - "\t\tNumber \tMean \t\tStandard Deviation \t% Standard Deviation \n", - "\tblind\t",numberOfBlinds,"\t",meanOfBlinds,"\t",stdOfBlinds,"\n", - "\tcontrol\t",numberOfControls,"\t",meanOfControls,"\t",stdOfControls,"\t\t",percentstdOfcontrols,"\n") - - par(ask=TRUE) - - boxplot(blinds$response,controls$response, - names=c("blinds","controls"), - ylab="Response",main=paste("Plate ",plate)) - - drdata <- platedata[c(2,4,6)] - drdata$substance <- factor(drdata$substance) - substances <- levels(drdata$substance) - - plot(log10(drdata$conc),drdata$viability, - xlim=c(-2.5, 4.5), - ylim= c(-0.1, 2), - xlab=paste("decadic logarithm of the concentration in ",levels(platedata$unit)), - ylab=responsetype) - - drdatalist <- split(drdata,drdata$substance) - - for (i in 1:length(drdatalist)) { - points(log10(drdatalist[[i]]$conc),drdatalist[[i]][[responsetype]],col=i); - } - - legend("topleft",substances, pch=1, col=1:length(substances), inset=0.05) - title(main=paste("Plate ",plate," - ",levels(platedata$experimentator)," - ",levels(platedata$type))) - } -} -- cgit v1.2.1