I added support for the enzyme test database.

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

1 files changed, 63 insertions, 35 deletions

diff --git a/R/drfit.R b/R/drfit.R
index 70e05df..fde2243 100644
--- a/R/drfit.R
+++ b/R/drfit.R
@@ -1,15 +1,25 @@
 drdata <- function(substances, experimentator = "%", db = "cytotox",

-    celltype="IPC-81",whereClause="1",

+    celltype="IPC-81",enzymetype="AChE",whereClause="1",

     ok="'ok'")

 {

     library(RODBC) 

-    channel <- odbcConnect("cytotox",uid="cytotox",pwd="cytotox",case="tolower")

+    channel <- odbcConnect(db,uid="cytotox",pwd="cytotox",case="tolower")

     slist <- paste(substances,collapse="','")

-    query <- paste("SELECT conc,viability,unit,experimentator,substance,celltype,",

-        "plate,ok FROM cytotox WHERE substance IN ('",

+    if (db == "cytotox") {

+        responsetype <- "viability"

+        testtype <- "celltype"

+        type <- celltype

+    } else {

+        responsetype <- "activity"

+        testtype <- "enzyme"

+        type <- enzymetype

+    }

+        

+    query <- paste("SELECT conc,",responsetype,",unit,experimentator,substance,",testtype,

+        ",plate,ok FROM ", db, " WHERE substance IN ('",

         slist,"') AND experimentator LIKE '",

-        experimentator,"' AND celltype LIKE '",

-        celltype,"' AND ",

+        experimentator,"' AND ",testtype," LIKE '",

+        type,"' AND ",

         whereClause," AND ok in (",

         ok,")",sep="")

     data <- sqlQuery(channel,query)

@@ -36,7 +46,9 @@ drfit <- function(data, startlogEC50 = NA, chooseone=TRUE,
         k*(1 + f*x) / (1 + ((2*f*(10^mu) + 1) * ((x/(10^mu))^b)))

     }

 

-    ri <- 0                               # an index over the result rows

+    ri <- rix <- 0                        # ri is the index over the result rows

+                                          # rix is used later to check if any

+                                          # model result was appended

     rsubstance <- array()                 # the substance names in the results

     rn <- vector()                        # number of dose-response curves 

     rlhd <- rlld <- vector()              # highest and lowest doses tested

@@ -52,13 +64,13 @@ drfit <- function(data, startlogEC50 = NA, chooseone=TRUE,
     for (i in substances) {

         tmp <- splitted[[i]]

         fit <- FALSE

+        n <- round(length(tmp$response)/9)

         if (length(tmp$response) == 0) {

             nodata = TRUE

         } else {

             nodata = FALSE

         }

         if (!nodata) {

-            n <- round(length(tmp$response)/9)

             if (is.na(startlogEC50[i])){

                 w <- 1/abs(tmp$response - 0.3)

                 startlogEC50[[i]] <- sum(w * log10(tmp$dose))/sum(w)

@@ -68,9 +80,7 @@ drfit <- function(data, startlogEC50 = NA, chooseone=TRUE,
             lhd <- log10(highestdose)

             lld <- log10(lowestdose)

             responseathighestdose <- mean(subset(tmp,dose==highestdose)$response)

-            rix <- ri                         # ri is the index of result lines

-                                              # rix is used later to check if any

-                                              # model result was appended

+            rix <- ri

             if (responseathighestdose < 0.5) {

                 inactive <- FALSE

 

@@ -404,10 +414,19 @@ drplot <- function(drresults, data = FALSE, dtype = "std", alpha = 0.95,
 checkplate <- function(plate,db="cytotox")

 {

     library(RODBC) 

-    channel <- odbcConnect(db,uid=db,pwd=db,case="tolower")

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

 

-    platequery <- paste("SELECT experimentator,substance,celltype,conc,unit,viability,performed,ok FROM ",

-        db," WHERE plate=", plate)

     controlquery <- paste("SELECT type,response FROM controls WHERE plate=",plate)

     

     platedata <- sqlQuery(channel,platequery)

@@ -419,7 +438,7 @@ checkplate <- function(plate,db="cytotox")
         cat("There is no response data for plate ",plate," in database ",db,"\n")

     } else {

         platedata$experimentator <- factor(platedata$experimentator)

-        platedata$celltype <- factor(platedata$celltype)

+        platedata$type <- factor(platedata[[testtype]])

         platedata$substance <- factor(platedata$substance)

         platedata$unit <- factor(platedata$unit)

         platedata$performed <- factor(platedata$performed)

@@ -437,7 +456,7 @@ checkplate <- function(plate,db="cytotox")
         

         cat("Plate ",plate," from database ",db,"\n",

             "\tExperimentator: ",levels(platedata$experimentator),"\n",

-            "\tCell type(s): ",levels(platedata$celltype),"\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",

@@ -450,36 +469,46 @@ checkplate <- function(plate,db="cytotox")
         

         boxplot(blinds$response,controls$response,names=c("blinds","controls"),ylab="Response",main=paste("Plate ",plate))

         

-        drdata <- subset(platedata,select=c(substance,conc,viability))

+        drdata <- platedata[c(2,4,6)]

         drdata$substance <- factor(drdata$substance)

         substances <- levels(drdata$substance)

-        substances

        

         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="Viability")

+            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]]$viability,col=i);

+            points(log10(drdatalist[[i]]$conc),drdatalist[[i]][[responsetype]],col=i);

         }

 

         legend(3.0,1.5,substances, pch=1, col=1:length(substances))

-        title(main=paste("Plate ",plate," - ",levels(platedata$experimentator)," - ",levels(platedata$celltype)))

+        title(main=paste("Plate ",plate," - ",levels(platedata$experimentator)," - ",levels(platedata$type)))

     }

 }

 

-checksubstance <- function(substance,db="cytotox",experimentator="%",celltype="%",whereClause="1",ok="%") 

+checksubstance <- function(substance,db="cytotox",experimentator="%",celltype="%",enzymetype="%",whereClause="1",ok="%") 

 {

     library(RODBC) 

-    channel <- odbcConnect(db,uid=db,pwd=db,case="tolower")

-    query <- paste("SELECT experimentator,substance,celltype,plate,conc,unit,viability,ok FROM cytotox WHERE substance LIKE '",

+    channel <- odbcConnect(db,uid="cytotox",pwd="cytotox",case="tolower")

+

+    if (db == "cytotox") {

+        responsetype <- "viability"

+        testtype <- "celltype"

+        type <- celltype

+    } else {

+        responsetype <- "activity"

+        testtype <- "enzyme"

+        type <- enzymetype

+    }

+    query <- paste("SELECT experimentator,substance,",testtype,",plate,conc,unit,",responsetype,",ok",

+        " FROM ",db," WHERE substance LIKE '",

         substance,"' AND experimentator LIKE '",

-        experimentator,"' AND celltype LIKE '",

-        celltype,"' AND ",

+        experimentator,"' AND ",testtype," LIKE '",

+        type,"' AND ",

         whereClause," AND ok LIKE '",ok,"'",sep="")

 

     data <- sqlQuery(channel,query)

@@ -488,7 +517,7 @@ checksubstance <- function(substance,db="cytotox",experimentator="%",celltype="%
     data$experimentator <- factor(data$experimentator)    

     data$substance <- factor(data$substance)

     substances <- levels(data$substance)    

-    data$celltype <- factor(data$celltype)                

+    data$type <- factor(data[[testtype]])                

     data$plate <- factor(data$plate)                        

     plates <- levels(data$plate)

     concentrations <- split(data$conc,data$conc)

@@ -500,25 +529,24 @@ checksubstance <- function(substance,db="cytotox",experimentator="%",celltype="%
         palette(rainbow(length(plates)))      

     }

  

-    plot(log10(data$conc),data$viability,                                               

+    plot(log10(data$conc),data[[responsetype]],

         xlim=c(-2.5, 4.5),                                                                  

         ylim= c(-0.1, 2),                                                                 

-        xlab=paste("Decadic Logarithm of the concentration in ",levels(data$unit)),    

-        ylab="Viability")  

+        xlab=paste("decadic logarithm of the concentration in ",levels(data$unit)),    

+        ylab=responsetype)  

         

     platelist <- split(data,data$plate)

    

     for (i in 1:length(platelist)) {    

-        points(log10(platelist[[i]]$conc),platelist[[i]]$viability,col=i);          

+        points(log10(platelist[[i]]$conc),platelist[[i]][[responsetype]],col=i);          

     }       

     

     legend(3.5,1.7,plates, pch=1, col=1:length(plates))

-    title(main=paste(substance," - ",levels(data$experimentator)," - ",levels(data$celltype)))

+    title(main=paste(substance," - ",levels(data$experimentator)," - ",levels(data$type)))

  

     cat("Substanz ",substance,"\n",

         "\tExperimentator(s):",levels(data$experimentator),"\n",

-        "\tCell type(s):\t",levels(data$celltype),"\n",

+        "\tType(s):\t",levels(data$type),"\n",

         "\tSubstance(s):\t",levels(data$substance),"\n",

         "\tPlate(s):\t",plates,"\n\n")

- 

 }