aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--DESCRIPTION4
-rw-r--r--R/checkexperiment.R10
-rw-r--r--R/drfit.R10
-rw-r--r--R/drplot.R14
-rw-r--r--man/checkexperiment.Rd2
-rw-r--r--tests/IM1xIPC81.Rout.save10
-rw-r--r--tests/IM1xVibrio.Rout.save12
-rw-r--r--tests/XY.Rout.save7
-rw-r--r--tests/antifoul.Rout.save6
-rw-r--r--tests/pyrithione.Rout.save19
10 files changed, 68 insertions, 26 deletions
diff --git a/DESCRIPTION b/DESCRIPTION
index c4b7819..01e66ed 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: drfit
-Version: 0.05-90
-Date: 2007-10-01
+Version: 0.05-92
+Date: 2007-11-23
Title: Dose-response data evaluation
Author: Johannes Ranke <jranke@uni-bremen.de>
Maintainer: Johannes Ranke <jranke@uni-bremen.de>
diff --git a/R/checkexperiment.R b/R/checkexperiment.R
index 941856b..58fecad 100644
--- a/R/checkexperiment.R
+++ b/R/checkexperiment.R
@@ -11,9 +11,16 @@ checkexperiment <- function(id, db = "ecotox", endpoint = "%")
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])
+
+ exptable <- paste(exptype, "s", sep="")
+ commentquery <- paste("SELECT comment FROM ", exptable ,
+ " WHERE ", exptype, " = ", id)
+ commentdata <- sqlQuery(channel,commentquery)
+ comment <- as.character(commentdata[[1]])
expquery <- paste("SELECT experimentator,substance, ",
testtype, ",conc,unit,", responsename, ",performed,ok",
@@ -83,7 +90,8 @@ checkexperiment <- function(id, db = "ecotox", endpoint = "%")
"\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",
+ "\tComment:\t\t",comment,"\n",
+ "\tOK Levels:\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",
diff --git a/R/drfit.R b/R/drfit.R
index 3bd9021..462bc43 100644
--- a/R/drfit.R
+++ b/R/drfit.R
@@ -32,13 +32,13 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE,
fit <- FALSE
if (length(tmp) != 0) {
unit <- levels(as.factor(as.vector(tmp$unit)))
- cat("\n",i,": Fitting data...\n",sep="")
+ message("\n",i,": Fitting data...\n")
} else {
unit <- ""
- cat("\n",i,": No data\n",sep="")
+ message("\n",i,": No data\n")
}
if (length(unit) > 1) {
- cat("More than one unit for substance ",i,", halting\n\n",sep="")
+ message("More than one unit for substance ",i,", halting\n\n")
break
}
if (length(tmp$response) == 0) {
@@ -211,8 +211,8 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE,
}
logED50[[ri]] <- nlm(sqrdev,startlogED50[[i]])$estimate
if (sqrdev(logED50[[ri]]) > 0.1) {
- cat("\nCan't find ED50 for fitted weibull model of ",i,
- "data\nwith startlogED50", startlogED50[[i]],"\n")
+ message("\nCan't find ED50 for fitted weibull model of ",i,
+ " data\nwith startlogED50 ", startlogED50[[i]],"\n")
ri <- ri - 1
length(a) <- length(b) <- ri
length(logED50) <- ri
diff --git a/R/drplot.R b/R/drplot.R
index 08a92d1..507119c 100644
--- a/R/drplot.R
+++ b/R/drplot.R
@@ -65,19 +65,19 @@ drplot <- function(drresults, data,
filename = paste(path,fileprefix,".eps",sep="")
postscript(file=filename,
paper="special",width=7,height=7,horizontal=FALSE, pointsize=pointsize)
- cat("Created File: ",filename,"\n")
+ message("Created File: ",filename,"\n")
}
if (pdf) {
filename = paste(path,fileprefix,".pdf",sep="")
pdf(file=filename,
paper="special",width=7,height=7,horizontal=FALSE, pointsize=pointsize)
- cat("Created File: ",filename,"\n")
+ message("Created File: ",filename,"\n")
}
if (png) {
filename = paste(path,fileprefix,".png",sep="")
png(filename=filename,
width=500, height=500, pointsize=pointsize)
- cat("Created File: ",filename,"\n")
+ message("Created File: ",filename,"\n")
}
plot(0,type="n",
@@ -114,19 +114,19 @@ drplot <- function(drresults, data,
filename = paste(path,fileprefix,sub(" ","_",i),".eps",sep="")
postscript(file=filename,
paper="special",width=7,height=7,horizontal=FALSE,pointsize=pointsize)
- cat("Created File: ",filename,"\n")
+ message("Created File: ",filename,"\n")
}
if (pdf) {
filename = paste(path,fileprefix,sub(" ","_",i),".pdf",sep="")
pdf(file=filename,
paper="special",width=7,height=7,horizontal=FALSE,pointsize=pointsize)
- cat("Created File: ",filename,"\n")
+ message("Created File: ",filename,"\n")
}
if (png) {
filename = paste(path,fileprefix,sub(" ","_",i),".png",sep="")
png(filename=filename,
width=500, height=500, pointsize=pointsize)
- cat("Created File: ",filename,"\n")
+ message("Created File: ",filename,"\n")
}
plot(0,type="n",
@@ -222,7 +222,7 @@ drplot <- function(drresults, data,
}
if (!overlay && (postscript || png || pdf)) dev.off()
} else {
- cat("No data for ",i,"\n")
+ message("No data for ",i,"\n")
}
}
}
diff --git a/man/checkexperiment.Rd b/man/checkexperiment.Rd
index 1162d1b..0edf2fb 100644
--- a/man/checkexperiment.Rd
+++ b/man/checkexperiment.Rd
@@ -22,7 +22,7 @@
the database "ecotox" is used. Defaults to "\%".}
}
\value{
- The function lists a report and shows two graphs side by side.
+ The function lists a report and shows two graphs.
}
\examples{
# Check plate number 3 in the cytotox database
diff --git a/tests/IM1xIPC81.Rout.save b/tests/IM1xIPC81.Rout.save
index b45d6f5..170243e 100644
--- a/tests/IM1xIPC81.Rout.save
+++ b/tests/IM1xIPC81.Rout.save
@@ -1,5 +1,5 @@
-R version 2.6.0 RC (2007-09-25 r42980)
+R version 2.6.0 (2007-10-03)
Copyright (C) 2007 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
@@ -23,7 +23,9 @@ Loading required package: RODBC
IM13 BF4: Fitting data...
+
IM14 BF4: Fitting data...
+
Error in nls(response ~ linlogitf(dose, 1, f, logED50, b), data = tmp, :
Convergence failure: false convergence (8)
Error in numericDeriv(form[[3]], names(ind), env, ifelse(internalPars < :
@@ -33,9 +35,12 @@ In pnorm(q, mean, sd, lower.tail, log.p) : NaNs produced
IM15 BF4: Fitting data...
+
IM16 BF4: Fitting data...
+
IM17 BF4: Fitting data...
+
Waiting for profiling to be done...
Error in numericDeriv(form[[3]], names(ind), env, ifelse(internalPars < :
Missing value or an infinity produced when evaluating the model
@@ -43,6 +48,7 @@ In addition: Warning message:
In pnorm(q, mean, sd, lower.tail, log.p) : NaNs produced
IM18 BF4: Fitting data...
+
Waiting for profiling to be done...
Error in numericDeriv(form[[3]], names(ind), env, ifelse(internalPars < :
Missing value or an infinity produced when evaluating the model
@@ -50,6 +56,7 @@ In addition: Warning message:
In pnorm(q, mean, sd, lower.tail, log.p) : NaNs produced
IM19 BF4: Fitting data...
+
Waiting for profiling to be done...
Error in numericDeriv(form[[3]], names(ind), env, ifelse(internalPars < :
Missing value or an infinity produced when evaluating the model
@@ -57,6 +64,7 @@ In addition: Warning message:
In pnorm(q, mean, sd, lower.tail, log.p) : NaNs produced
IM1-10 BF4: Fitting data...
+
Waiting for profiling to be done...
> print(rIM1xIPC81,digits=5)
Substance ndl n lld lhd mtype logED50 2.5% 97.5% unit
diff --git a/tests/IM1xVibrio.Rout.save b/tests/IM1xVibrio.Rout.save
index 6ba7310..e08e9e5 100644
--- a/tests/IM1xVibrio.Rout.save
+++ b/tests/IM1xVibrio.Rout.save
@@ -1,6 +1,6 @@
-R version 2.4.1 (2006-12-18)
-Copyright (C) 2006 The R Foundation for Statistical Computing
+R version 2.6.0 (2007-10-03)
+Copyright (C) 2007 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
R is free software and comes with ABSOLUTELY NO WARRANTY.
@@ -22,27 +22,35 @@ Loading required package: RODBC
> rIM1xVibrio <- drfit(IM1xVibrio)
IM13 BF4: Fitting data...
+
Waiting for profiling to be done...
IM14 BF4: Fitting data...
+
Waiting for profiling to be done...
IM15 BF4: Fitting data...
+
Waiting for profiling to be done...
IM16 BF4: Fitting data...
+
Waiting for profiling to be done...
IM17 BF4: Fitting data...
+
Waiting for profiling to be done...
IM18 BF4: Fitting data...
+
Waiting for profiling to be done...
IM19 BF4: Fitting data...
+
Waiting for profiling to be done...
IM1-10 BF4: Fitting data...
+
Waiting for profiling to be done...
> print(rIM1xVibrio,digits=5)
Substance ndl n lld lhd mtype logED50 2.5% 97.5% unit
diff --git a/tests/XY.Rout.save b/tests/XY.Rout.save
index 9172e08..e59ab76 100644
--- a/tests/XY.Rout.save
+++ b/tests/XY.Rout.save
@@ -1,6 +1,6 @@
-R version 2.4.1 (2006-12-18)
-Copyright (C) 2006 The R Foundation for Statistical Computing
+R version 2.6.0 (2007-10-03)
+Copyright (C) 2007 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
R is free software and comes with ABSOLUTELY NO WARRANTY.
@@ -23,11 +23,14 @@ Loading required package: RODBC
Control: Fitting data...
+
Substance X: Fitting data...
+
Waiting for profiling to be done...
Waiting for profiling to be done...
Substance Y: Fitting data...
+
> print(rXY,digits=5)
Substance ndl n lld lhd mtype logED50 2.5% 97.5% unit sigma
1 Control 1 6 -Inf -Inf inactive NA NA NA mg/L NA
diff --git a/tests/antifoul.Rout.save b/tests/antifoul.Rout.save
index 7bcba6a..28f8ad0 100644
--- a/tests/antifoul.Rout.save
+++ b/tests/antifoul.Rout.save
@@ -1,6 +1,6 @@
-R version 2.4.1 (2006-12-18)
-Copyright (C) 2006 The R Foundation for Statistical Computing
+R version 2.6.0 (2007-10-03)
+Copyright (C) 2007 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
R is free software and comes with ABSOLUTELY NO WARRANTY.
@@ -22,9 +22,11 @@ Loading required package: RODBC
> rantifoul <- drfit(antifoul)
TBT: Fitting data...
+
Waiting for profiling to be done...
Zn Pyrithion: Fitting data...
+
Waiting for profiling to be done...
> print(rantifoul,digits=5)
Substance ndl n lld lhd mtype logED50 2.5% 97.5% unit
diff --git a/tests/pyrithione.Rout.save b/tests/pyrithione.Rout.save
index 6df94db..4a045a3 100644
--- a/tests/pyrithione.Rout.save
+++ b/tests/pyrithione.Rout.save
@@ -1,6 +1,6 @@
-R version 2.4.1 (2006-12-18)
-Copyright (C) 2006 The R Foundation for Statistical Computing
+R version 2.6.0 (2007-10-03)
+Copyright (C) 2007 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
R is free software and comes with ABSOLUTELY NO WARRANTY.
@@ -22,43 +22,56 @@ Loading required package: RODBC
> rpyr <- drfit(pyrithione,linlogit=TRUE,linlogitWrong=c("MSPT","MSPHI"))
Na Pyrithion: Fitting data...
+
Waiting for profiling to be done...
Error in prof$getProfile() : attempt to apply non-function
Pyridin: Fitting data...
+
PyNO: Fitting data...
+
Error in nls(response ~ linlogitf(dose, 1, f, logED50, b), data = tmp, :
- Convergence failure: false convergence (8)
+ Convergence failure: false convergence (8)
(PT)2: Fitting data...
+
Waiting for profiling to be done...
MSO2P: Fitting data...
+
MSPHI: Fitting data...
+
Waiting for profiling to be done...
PyS: Fitting data...
+
Waiting for profiling to be done...
Error in prof$getProfile() : attempt to apply non-function
Zn Pyrithion: Fitting data...
+
Waiting for profiling to be done...
Cu Pyrithion: Fitting data...
+
Waiting for profiling to be done...
Fe Pyrithion: Fitting data...
+
Waiting for profiling to be done...
MSPT: Fitting data...
+
Waiting for profiling to be done...
TBT: Fitting data...
+
Waiting for profiling to be done...
NaJ: Fitting data...
+
> print(rpyr,digits=3)
Substance ndl n lld lhd mtype logED50 2.5% 97.5% unit sigma
1 Na Pyrithion 20 108 -2.107 2.0 linlogit -0.346 NA NA microM 0.209

Contact - Imprint