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

2 files changed, 50 insertions, 113 deletions

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