- New version just published on my website

- Fixes in checkplate, checksubstance and checkexperiment
- New arguments ltys, xlab and ylab in drplot, due to a request by
  Ewa Mulkiewicz



git-svn-id: http://kriemhild.uft.uni-bremen.de/svn/drfit@83 d1b72e20-2ee0-0310-a1c4-ad5adbbefcdc

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 = "")
 }
diff --git a/R/drplot.R b/R/drplot.R
index 120a4b5..85e174f 100644
--- a/R/drplot.R
+++ b/R/drplot.R
@@ -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()