aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
Diffstat (limited to 'R')
-rw-r--r--R/checkexperiment.R41
-rw-r--r--R/checkplate.R4
-rw-r--r--R/checksubstance.R86
-rw-r--r--R/drplot.R36
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()

Contact - Imprint