diff options
| author | ranke <ranke@d1b72e20-2ee0-0310-a1c4-ad5adbbefcdc> | 2007-11-23 16:19:08 +0000 |
|---|---|---|
| committer | ranke <ranke@d1b72e20-2ee0-0310-a1c4-ad5adbbefcdc> | 2007-11-23 16:19:08 +0000 |
| commit | 1066c87b174f2b3df19e54adee1ee435021441c9 (patch) | |
| tree | 26003c9a4a333ecdc99ef6773a6df96572f51c11 | |
| parent | e6b9164327957c56de221889e396dcbab6fddd31 (diff) | |
- Releasable version for CRAN
- Changed usage of cat() to message() because the latter does not interfere
with Sweave. Left cat() in checkexperiment.R and checksubstance.R
git-svn-id: http://kriemhild.uft.uni-bremen.de/svn/drfit@92 d1b72e20-2ee0-0310-a1c4-ad5adbbefcdc
| -rw-r--r-- | DESCRIPTION | 4 | ||||
| -rw-r--r-- | R/checkexperiment.R | 10 | ||||
| -rw-r--r-- | R/drfit.R | 10 | ||||
| -rw-r--r-- | R/drplot.R | 14 | ||||
| -rw-r--r-- | man/checkexperiment.Rd | 2 | ||||
| -rw-r--r-- | tests/IM1xIPC81.Rout.save | 10 | ||||
| -rw-r--r-- | tests/IM1xVibrio.Rout.save | 12 | ||||
| -rw-r--r-- | tests/XY.Rout.save | 7 | ||||
| -rw-r--r-- | tests/antifoul.Rout.save | 6 | ||||
| -rw-r--r-- | tests/pyrithione.Rout.save | 19 |
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", @@ -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 @@ -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 |