From fec95dfbf0abe4175649e399eb1fcd698d482a9a Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Thu, 30 Mar 2017 17:54:16 +0200 Subject: Add checkcontrols, updates, see ChangeLog --- ChangeLog | 14 +++++++----- DESCRIPTION | 6 ++--- GNUmakefile | 5 ++++- R/checkexperiment.R | 28 ++++++++++++------------ R/checksubstance.R | 52 ++++++++++++++++++++++---------------------- R/drcfit.R | 34 +++++++++++++++++------------ R/drdata.R | 2 +- R/drfit.R | 47 ++++++++++++++++++++++----------------- R/drplot.R | 36 +++++++++++++++--------------- check.log | 17 ++++++++++++--- docs/index.html | 10 ++++----- docs/reference/antifoul.html | 29 +++++++++++++++++++++++- docs/reference/drcfit.html | 11 +++++++++- man/IM1xIPC81.Rd | 2 +- man/IM1xVibrio.Rd | 8 +++---- man/XY.Rd | 2 +- man/antifoul.Rd | 12 +++++----- man/checkcontrols.Rd | 12 +++++----- man/checkexperiment.Rd | 4 ++-- man/checksubstance.Rd | 14 ++++++------ man/drcfit.Rd | 20 ++++++++--------- man/drdata.Rd | 22 +++++++++---------- man/drfit-package.Rd | 2 +- man/drfit.Rd | 22 +++++++++---------- man/drplot.Rd | 26 +++++++++++----------- man/linlogitf.Rd | 6 ++--- tests/IM1xIPC81.Rout.save | 29 +++++++----------------- tests/pyrithione.Rout.save | 14 +++++------- 28 files changed, 268 insertions(+), 218 deletions(-) mode change 100755 => 100644 man/linlogitf.Rd diff --git a/ChangeLog b/ChangeLog index 3e539fa..132c7c2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,14 +1,18 @@ -2017-03-24 Johannes Ranke +2017-03-30 Johannes Ranke * DESCRIPTION: New verson 0.7.1 + * Change package encoding to UTF-8 * Add checkcontrols() function * Add static documentation using pkgdown + * R/drfit.R: Suppress error messages to pass CRAN checks for examples + * Update test results + * Remove trailing whitespace and mixed indentation in source files 2016-09-02 Johannes Ranke * Make drcfit compatible with drc >= 3.0.1 (the row names of the matrix returned by the ED() function were changed). - * Switch back to using requireNamespace(RODBC) in order to address + * Switch back to using requireNamespace(RODBC) in order to address a NOTE issued by R CMD check * Use single quotes to quote other packages in the DESCRIPTION file @@ -20,7 +24,7 @@ 2015-10-07 Johannes Ranke * Suggest RODBC instead of depending on it, as it is not available - on all CRAN check systems. + on all CRAN check systems. * Adress various NOTES given by R CMD check @@ -43,12 +47,12 @@ drfit(), but internally uses the methods supplied by the drc package * R/{drfit,drcfit}.R: Return the list of fitted models in an attribute of - the resulting dataframe. Deal with the case of only NA values in the unit + the resulting dataframe. Deal with the case of only NA values in the unit column of the data. * R/drfit.R: Use the fitted nls() models directly to calculate EDx values - * R/drplot.R: Use different point characters (pch) for the data, and add the + * R/drplot.R: Use different point characters (pch) for the data, and add the possibility to specify them using the argument pchs. Also make drplot() work for the results from the drcfit function. diff --git a/DESCRIPTION b/DESCRIPTION index 452e608..ae9f00d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: drfit Version: 0.7.1 -Date: 2017-03-24 +Date: 2017-03-30 Title: Dose-Response Data Evaluation -Authors@R: c(person("Johannes", "Ranke", role = c("aut", "cre"), +Authors@R: c(person("Johannes", "Ranke", role = c("aut", "cre"), email = "jranke@uni-bremen.de")) Imports: graphics, grDevices, MASS, drc, reshape2, qcc Suggests: RODBC @@ -18,7 +18,7 @@ Description: A somewhat outdated package of basic and easy-to-use functions for dose-response data retrieved from a database accessed via 'RODBC' are included. As an alternative to the original fitting methods, the algorithms from the 'drc' package can be used. -Encoding: latin1 +Encoding: UTF-8 License: GPL (>= 2) LazyLoad: yes LazyData: yes diff --git a/GNUmakefile b/GNUmakefile index 7f7e85c..59f3835 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -16,7 +16,10 @@ install: build "$(RBIN)/R" CMD INSTALL $(TGZ) check: build - "$(RBIN)/R" CMD check --as-cran --no-tests $(TGZ) 2>&1 | tee check.log + "$(RBIN)/R" CMD check --as-cran $(TGZ) 2>&1 | tee check.log + +quickcheck: build + "$(RBIN)/R" CMD check $(TGZ) 2>&1 | tee check.log pd: "$(RBIN)/Rscript" -e "pkgdown::build_site()" diff --git a/R/checkexperiment.R b/R/checkexperiment.R index 8c2f472..b69b81f 100644 --- a/R/checkexperiment.R +++ b/R/checkexperiment.R @@ -25,21 +25,21 @@ checkexperiment <- function(id, db = "ecotox", endpoint = "%") " WHERE ", exptype, " = ", id) commentdata <- RODBC::sqlQuery(channel,commentquery) comment <- as.character(commentdata[[1]]) - + expquery <- paste("SELECT experimentator,substance, ", testtype, ",conc,unit,", responsename, ",performed,ok", - " FROM ",db," WHERE ",exptype,"=", id, + " FROM ",db," WHERE ",exptype,"=", id, sep = "") if (db == "ecotox") { - expquery <- paste(expquery, " AND type LIKE '", + expquery <- paste(expquery, " AND type LIKE '", endpoint, "'", sep = "") } expdata <- RODBC::sqlQuery(channel,expquery) if (db %in% c("cytotox","enzymes")) { - controlquery <- paste("SELECT type,response FROM controls + controlquery <- paste("SELECT type,response FROM controls WHERE plate=",id) controldata <- RODBC::sqlQuery(channel,controlquery) } @@ -63,7 +63,7 @@ checkexperiment <- function(id, db = "ecotox", endpoint = "%") numberOfBlinds <- NA meanOfBlinds <- NA stdOfBlinds <- NA - + } numberOfControls <- length(controls$response) if (numberOfControls > 0) { @@ -78,7 +78,7 @@ checkexperiment <- function(id, db = "ecotox", endpoint = "%") 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) @@ -87,7 +87,7 @@ checkexperiment <- function(id, db = "ecotox", endpoint = "%") expdata$substance <- factor(expdata$substance) expdata$unit <- factor(expdata$unit) expdata$ok <- factor(expdata$ok) - + cat("\n",exptypestring,id,"from database",db,":\n\n", "\tExperimentator(s):\t",levels(expdata$experimentator),"\n", "\tType(s):\t\t",levels(expdata$type),"\n", @@ -100,7 +100,7 @@ checkexperiment <- function(id, db = "ecotox", endpoint = "%") "\tblind\t",numberOfBlinds,"\t",meanOfBlinds,"\t",stdOfBlinds,"\n", "\tcontrol\t",numberOfControls,"\t",meanOfControls,"\t", stdOfControls,"\t\t",percentstdOfcontrols,"\n") - + if (db == "ecotox") { boxplot(controls$response, @@ -116,22 +116,22 @@ checkexperiment <- function(id, db = "ecotox", endpoint = "%") boxwex=0.4, main=paste("Plate ",id)) } - + drdata <- expdata[c(2,4,6)] drdata$substance <- factor(drdata$substance) substances <- levels(drdata$substance) - + lld <- log10(min(subset(drdata,conc!=0)$conc)) lhd <- log10(max(drdata$conc)) plot(1,type="n", - xlim=c(lld - 0.5, lhd + 2), - ylim= c(-0.1, 2), + xlim=c(lld - 0.5, lhd + 2), + ylim= c(-0.1, 2), xlab=paste("decadic logarithm of the concentration in ",levels(expdata$unit)), ylab=responsename) - + drdatalist <- split(drdata,drdata$substance) - + for (i in 1:length(drdatalist)) { points(log10(drdatalist[[i]]$conc),drdatalist[[i]][[responsename]],col=i); } diff --git a/R/checksubstance.R b/R/checksubstance.R index 3e07f92..06cc635 100644 --- a/R/checksubstance.R +++ b/R/checksubstance.R @@ -1,7 +1,7 @@ checksubstance <- function(substance, db = "cytotox", experimentator = "%", - celltype = "%", enzymetype = "%", organism = "%", + celltype = "%", enzymetype = "%", organism = "%", endpoint = "%", - whereClause = "1", ok= "%") + whereClause = "1", ok= "%") { databases <- data.frame( responsename=c("viability","activity","response"), @@ -23,13 +23,13 @@ checksubstance <- function(substance, db = "cytotox", experimentator = "%", if (db == "cytotox") { type <- celltype - } + } if (db == "enzymes") { type <- enzymetype - } + } if (db == "ecotox") { type <- organism - } + } query <- paste("SELECT experimentator,substance,", testtype, ",", exptype, ",conc,unit,",responsename,",ok", @@ -41,7 +41,7 @@ checksubstance <- function(substance, db = "cytotox", experimentator = "%", sep = "") if (db == "ecotox") { - query <- paste(query, " AND type LIKE '", + query <- paste(query, " AND type LIKE '", endpoint, "'", sep = "") } @@ -51,39 +51,39 @@ checksubstance <- function(substance, db = "cytotox", experimentator = "%", 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$experimentator <- factor(data$experimentator) data$substance <- factor(data$substance) - substances <- levels(data$substance) - data$type <- factor(data[[testtype]]) - data[[exptype]] <- factor(data[[exptype]]) + substances <- levels(data$substance) + data$type <- factor(data[[testtype]]) + 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$unit <- factor(data$unit) data$ok <- factor(data$ok) if (length(experiments)>6) { - palette(rainbow(length(experiments))) + palette(rainbow(length(experiments))) } - + 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=responsename) - + xlim=c(-2.5, 4.5), + ylim= c(-0.1, 2), + xlab=paste("decadic logarithm of the concentration in ",levels(data$unit)), + ylab=responsename) + explist <- split(data,data[[exptype]]) - - for (i in 1:length(explist)) { - points(log10(explist[[i]]$conc),explist[[i]][[responsename]],col=i); - } - + + for (i in 1:length(explist)) { + points(log10(explist[[i]]$conc),explist[[i]][[responsename]],col=i); + } + legend("topleft", experiments, pch=1, col=1:length(experiments), inset=0.05) title(main=paste(substance," - ",levels(data$experimentator)," - ",levels(data$type))) - exptypename <- paste(toupper(substring(exptype,1,1)), + exptypename <- paste(toupper(substring(exptype,1,1)), substring(exptype,2), sep = "") experimentators <- paste(levels(data$experimentator), collapse = " ") types <- paste(levels(data$type), collapse = " ") diff --git a/R/drcfit.R b/R/drcfit.R index 008c53c..64426b9 100644 --- a/R/drcfit.R +++ b/R/drcfit.R @@ -14,7 +14,7 @@ drcfit <- function(data, chooseone=TRUE, # model result was appended rsubstance <- array() # the substance names in the results rndl <- vector() # number of dose levels - rn <- vector() # mean number of replicates + rn <- vector() # mean number of replicates # in each dose level runit <- vector() # vector of units for each result row rlhd <- rlld <- vector() # highest and lowest doses tested @@ -79,7 +79,8 @@ drcfit <- function(data, chooseone=TRUE, active <- FALSE if (linlogit) { - m <- try(drm(response ~ dose, data = tmp, fct = BC.4(fixed = c(NA, 1, NA, NA)))) + m <- try(drm(response ~ dose, data = tmp, fct = BC.4(fixed = c(NA, 1, NA, NA))), + silent = TRUE) if (chooseone==FALSE || fit==FALSE) { if (!inherits(m, "try-error")) { fit <- TRUE @@ -100,10 +101,11 @@ drcfit <- function(data, chooseone=TRUE, a[[ri]] <- coef(m)[[2]] b[[ri]] <- coef(m)[[1]] c[[ri]] <- coef(m)[[3]] - ED50 <- try(ED(m, 50, interval = "delta", + ED50 <- try(ED(m, 50, interval = "delta", lower = lowestdose / 10, upper = highestdose * 10, - display = FALSE)) + display = FALSE), + silent = TRUE) if (!inherits(ED50, "try-error")) { logED50[[ri]] <- log10(ED50[ED50_row_index, "Estimate"]) logED50low[[ri]] <- log10(ED50[ED50_row_index, "Lower"]) @@ -111,14 +113,15 @@ drcfit <- function(data, chooseone=TRUE, if (logED50[[ri]] > rlhd[[ri]]) { mtype[[ri]] <- "no fit" } - } + } } } } if (probit) { - m <- try(drm(response ~ dose, data = tmp, - fct = LN.2())) + m <- try(drm(response ~ dose, data = tmp, + fct = LN.2()), + silent = TRUE) if (chooseone==FALSE || fit==FALSE) { if (!inherits(m, "try-error")) { fit <- TRUE @@ -152,7 +155,8 @@ drcfit <- function(data, chooseone=TRUE, } if (logit) { - m <- try(drm(response ~ dose, data = tmp, fct = LL.2())) + m <- try(drm(response ~ dose, data = tmp, fct = LL.2()), + silent = TRUE) if (chooseone==FALSE || fit==FALSE) { if (!inherits(m, "try-error")) { fit <- TRUE @@ -189,7 +193,8 @@ drcfit <- function(data, chooseone=TRUE, } if (weibull) { - m <- try(drm(response ~ dose, data = tmp, fct = W1.2())) + m <- try(drm(response ~ dose, data = tmp, fct = W1.2()), + silent = TRUE) if (chooseone==FALSE || fit==FALSE) { if (!inherits(m, "try-error")) { fit <- TRUE @@ -262,7 +267,7 @@ drcfit <- function(data, chooseone=TRUE, } } - results <- data.frame(rsubstance, rndl, rn, rlld, rlhd, mtype, + results <- data.frame(rsubstance, rndl, rn, rlld, rlhd, mtype, logED50, logED50low, logED50high, runit, sigma, a, b) lower_level_percent = paste(100 * (1 - level)/2, "%", sep = "") upper_level_percent = paste(100 * (1 + level)/2, "%", sep = "") @@ -285,13 +290,14 @@ drcfit <- function(data, chooseone=TRUE, mtype <- as.character(results[row.i, "mtype"]) if (mtype %in% c("probit", "logit", "weibull", "linlogit")) { for (EDi in EDx) { - EDx.drc = try(ED(m, EDi, interval = "delta", display = FALSE, level = level)) + EDx.drc = try(ED(m, EDi, interval = "delta", display = FALSE, level = level), + silent = TRUE) if (!inherits(EDx.drc, "try-error")) { - results[row.i, paste0("EDx", EDi)] <- + results[row.i, paste0("EDx", EDi)] <- EDx.drc[paste(EDx_row_index_prefix, EDi, sep = ":"), "Estimate"] - results[row.i, paste0("EDx", EDi, " ", lower_level_percent)] <- + results[row.i, paste0("EDx", EDi, " ", lower_level_percent)] <- EDx.drc[paste(EDx_row_index_prefix, EDi, sep = ":"), "Lower"] - results[row.i, paste0("EDx", EDi, " ", upper_level_percent)] <- + results[row.i, paste0("EDx", EDi, " ", upper_level_percent)] <- EDx.drc[paste(EDx_row_index_prefix, EDi, sep = ":"), "Upper"] } } diff --git a/R/drdata.R b/R/drdata.R index 0bf9597..dc741a6 100644 --- a/R/drdata.R +++ b/R/drdata.R @@ -21,7 +21,7 @@ drdata <- function(substances, experimentator = "%", db = "cytotox", type <- organism } } - + query <- paste("SELECT conc,",responsetype,",unit,experimentator,substance,",testtype, ",ok FROM ", db, " WHERE substance IN ('", slist,"') AND experimentator LIKE '", diff --git a/R/drfit.R b/R/drfit.R index 7fa53bf..65ab8e4 100644 --- a/R/drfit.R +++ b/R/drfit.R @@ -18,7 +18,7 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE, # model result was appended rsubstance <- array() # the substance names in the results rndl <- vector() # number of dose levels - rn <- vector() # mean number of replicates + rn <- vector() # mean number of replicates # in each dose level runit <- vector() # vector of units for each result row rlhd <- rlld <- vector() # highest and lowest doses tested @@ -75,12 +75,13 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE, active <- TRUE } else { active <- FALSE - if (linlogit && + if (linlogit && length(subset(linlogitWrong,linlogitWrong == i))==0 && length(subset(allWrong,allWrong == i))==0) { m <- try(nls(response ~ linlogitf(dose,1,f,logED50,b), - data=tmp, algorithm="port", - start=list(f=f0,logED50=startlogED50[[i]],b=b0))) + data=tmp, algorithm="port", + start=list(f=f0,logED50=startlogED50[[i]],b=b0)), + silent = TRUE) if (!inherits(m, "try-error")) { fit <- TRUE ri <- ri + 1 @@ -104,7 +105,8 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE, c[[ri]] <- NA } else { mtype[[ri]] <- "linlogit" - logED50conf <- try(confint(m,"logED50",level=level)) + logED50conf <- try(confint(m,"logED50",level=level), + silent = TRUE) if (!inherits(logED50conf, "try-error")) { logED50low[[ri]] <- logED50conf[[1]] logED50high[[ri]] <- logED50conf[[2]] @@ -122,8 +124,9 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE, if (probit && length(subset(allWrong,allWrong == i))==0) { m <- try(nls(response ~ pnorm(-log10(dose),-logED50,scale), - data=tmp, algorithm="port", - start=list(logED50=startlogED50[[i]],scale=ps0))) + data=tmp, algorithm="port", + start=list(logED50=startlogED50[[i]],scale=ps0)), + silent = TRUE) if (chooseone==FALSE || fit==FALSE) { if (!inherits(m, "try-error")) { fit <- TRUE @@ -148,7 +151,8 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE, b[[ri]] <- NA } else { mtype[[ri]] <- "probit" - logED50conf <- try(confint(m,"logED50",level=level)) + logED50conf <- try(confint(m,"logED50",level=level), + silent = TRUE) if (!inherits(logED50conf, "try-error")) { logED50low[[ri]] <- logED50conf[[1]] logED50high[[ri]] <- logED50conf[[2]] @@ -166,8 +170,9 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE, if (logit && length(subset(allWrong,allWrong == i))==0) { m <- try(nls(response ~ plogis(-log10(dose),-logED50,scale), - data=tmp, algorithm="port", - start=list(logED50=startlogED50[[i]],scale=ls0))) + data=tmp, algorithm="port", + start=list(logED50=startlogED50[[i]],scale=ls0)), + silent = TRUE) if (chooseone==FALSE || fit==FALSE) { if (!inherits(m, "try-error")) { fit <- TRUE @@ -193,7 +198,8 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE, b[[ri]] <- NA } else { mtype[[ri]] <- "logit" - logED50conf <- try(confint(m,"logED50",level=level)) + logED50conf <- try(confint(m,"logED50",level=level), + silent = TRUE) if (!inherits(logED50conf, "try-error")) { logED50low[[ri]] <- logED50conf[[1]] logED50high[[ri]] <- logED50conf[[2]] @@ -209,8 +215,9 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE, if (weibull && length(subset(allWrong,allWrong == i))==0) { m <- try(nls(response ~ pweibull(-log10(dose)+location,shape), - data=tmp, algorithm="port", - start=list(location=startlogED50[[i]],shape=ws0))) + data=tmp, algorithm="port", + start=list(location=startlogED50[[i]],shape=ws0)), + silent = TRUE) if (chooseone==FALSE || fit==FALSE) { if (!inherits(m, "try-error")) { ri <- ri + 1 @@ -218,7 +225,7 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE, a[[ri]] <- coef(m)[["location"]] b[[ri]] <- coef(m)[["shape"]] sqrdev <- function(logdose) { - (0.5 - pweibull( - logdose + a[[ri]], b[[ri]]))^2 + (0.5 - pweibull( - logdose + a[[ri]], b[[ri]]))^2 } logED50[[ri]] <- nlm(sqrdev,startlogED50[[i]])$estimate if (sqrdev(logED50[[ri]]) > 0.1) { @@ -291,7 +298,7 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE, c[[ri]] <- NA } } - results <- data.frame(rsubstance, rndl, rn, rlld, rlhd, mtype, + results <- data.frame(rsubstance, rndl, rn, rlld, rlhd, mtype, logED50, logED50low, logED50high, runit, sigma, a, b) lower_level_percent = paste(100 * (1 - level)/2, "%", sep = "") upper_level_percent = paste(100 * (1 + level)/2, "%", sep = "") @@ -311,18 +318,18 @@ drfit <- function(data, startlogED50 = NA, chooseone=TRUE, if (mtype[[row.i]] %in% c("probit", "logit", "weibull", "linlogit")) { for (ED in EDx) { of <- function(x) { - abs(predict(models[[row.i]], data.frame(dose = 10^x)) - + abs(predict(models[[row.i]], data.frame(dose = 10^x)) - (1 - (ED/100))) - } - # Search over interval starting an order of magnitude below + } + # Search over interval starting an order of magnitude below # the lowest dose up to one order of magnitude above the # highest dose - o = optimize(of, + o = optimize(of, results[row.i, c("lld", "lhd")] + c(-1, 1)) # Only keep results within the tolerance if ((o$objective) < EDx.tolerance) { logdose.ED = o$minimum - results[row.i, paste0("EDx", ED)] <- 10^logdose.ED + results[row.i, paste0("EDx", ED)] <- 10^logdose.ED } } } diff --git a/R/drplot.R b/R/drplot.R index 11c4d42..1e6b2cd 100644 --- a/R/drplot.R +++ b/R/drplot.R @@ -1,12 +1,12 @@ if(getRversion() >= '2.15.1') utils::globalVariables(c("dose", "Substance", "mtype")) -drplot <- function(drresults, data, +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", axes = TRUE, frame.plot = TRUE, - postscript = FALSE, pdf = FALSE, png = FALSE, + postscript = FALSE, pdf = FALSE, png = FALSE, bw = TRUE, pointsize = 12, colors = 1:8, ltys = 1:8, pchs = "auto", @@ -24,7 +24,7 @@ drplot <- function(drresults, data, if(is.data.frame(data)) { # Get rid of pseudo substance names of controls nonzerodata <- subset(data,dose!=0) - nonzerodata$substance <- factor(nonzerodata$substance) + nonzerodata$substance <- factor(nonzerodata$substance) zerodata <- subset(data,dose==0) nc <- length(zerodata$dose) # Number of control points if (nc > 0) { @@ -44,12 +44,12 @@ drplot <- function(drresults, data, hr <- max(nonzerodata$response) if (ctype == "std") hr <- max(hr,1 + sdc) if (ctype == "conf") hr <- max(hr,1 + controlconf) - dsubstances <- levels(nonzerodata$substance) + dsubstances <- levels(nonzerodata$substance) } else { lld <- min(drresults[["logED50"]],na.rm=TRUE) - 2 lhd <- max(drresults[["logED50"]],na.rm=TRUE) + 2 if (length(subset(drresults,mtype=="linlogit")$Substance) != 0) { - hr <- 1.8 + hr <- 1.8 } else { hr <- 1.0 } @@ -70,20 +70,20 @@ drplot <- function(drresults, data, postscript(file=filename, paper="special",width=7,height=7,horizontal=FALSE, pointsize=pointsize) 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) message("Created File: ",filename,"\n") - } + } if (png) { filename = paste(path,fileprefix,".png",sep="") png(filename=filename, width=500, height=500, pointsize=pointsize) message("Created File: ",filename,"\n") } - + plot(0,type="n", xlim = xlim, ylim = ylim, @@ -97,7 +97,7 @@ drplot <- function(drresults, data, if (!postscript && !png && !pdf && length(dsubstances) > 1) { op <- par(ask=TRUE) on.exit(par(op)) - } + } } # nl is the overall number of fits to draw by different line types nl <- 0 @@ -123,20 +123,20 @@ drplot <- function(drresults, data, postscript(file=filename, paper="special",width=7,height=7,horizontal=FALSE,pointsize=pointsize) 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) message("Created File: ",filename,"\n") - } + } if (png) { filename = paste(path,fileprefix,sub(" ","_",i),".png",sep="") png(filename=filename, width=500, height=500, pointsize=pointsize) message("Created File: ",filename,"\n") } - + plot(0,type="n", xlim = xlim, ylim = ylim, @@ -147,7 +147,7 @@ drplot <- function(drresults, data, } if (!overlay) legend(lpos, i, lty = 1, col = color, pch = pch, inset=0.05) tmp$dosefactor <- factor(tmp$dose) # necessary because the old - # factor has all levels, not + # factor has all levels, not # only the ones tested with # this substance @@ -157,7 +157,7 @@ drplot <- function(drresults, data, abline(h = 1 + sdc, lty = 2) } if (ctype == "conf") { - abline(h = 1 - controlconf, lty = 2) + abline(h = 1 - controlconf, lty = 2) abline(h = 1 + controlconf, lty = 2) } @@ -179,7 +179,7 @@ drplot <- function(drresults, data, } if (dtype == "conf") { - confidencedeltas <- qt((1 + alpha)/2, lengths - 1) * sqrt(vars) + confidencedeltas <- qt((1 + alpha)/2, lengths - 1) * sqrt(vars) tops <- means + confidencedeltas bottoms <- means - confidencedeltas } @@ -207,13 +207,13 @@ drplot <- function(drresults, data, if (drresults[[fit.row, "mtype"]] %in% c("probit", "logit", "weibull", - "linlogit")) + "linlogit")) { m <- attr(drresults, "models")[[as.numeric(fit.row)]] of <- function(x) { predict(m, data.frame(dose = 10^x)) - } - plot(of, lld - 0.5, lhd + 2, + } + plot(of, lld - 0.5, lhd + 2, add = TRUE, col = color, lty = lty) } } diff --git a/check.log b/check.log index c074e40..5d1e47c 100644 --- a/check.log +++ b/check.log @@ -2,10 +2,10 @@ * using R version 3.3.3 (2017-03-06) * using platform: x86_64-pc-linux-gnu (64-bit) * using session charset: UTF-8 -* using options ‘--no-tests --as-cran’ +* using option ‘--as-cran’ * checking for file ‘drfit/DESCRIPTION’ ... OK * this is package ‘drfit’ version ‘0.7.1’ -* package encoding: latin1 +* package encoding: UTF-8 * checking CRAN incoming feasibility ... Note_to_CRAN_maintainers Maintainer: ‘Johannes Ranke ’ * checking package namespace information ... OK @@ -54,7 +54,18 @@ Maintainer: ‘Johannes Ranke ’ * checking installed files from ‘inst/doc’ ... OK * checking examples ... OK * checking for unstated dependencies in ‘tests’ ... OK -* checking tests ... SKIPPED +* checking tests ... + Running ‘IM1xIPC81.R’ + Comparing ‘IM1xIPC81.Rout’ to ‘IM1xIPC81.Rout.save’ ... OK + Running ‘IM1xVibrio.R’ + Comparing ‘IM1xVibrio.Rout’ to ‘IM1xVibrio.Rout.save’ ... OK + Running ‘XY.R’ + Comparing ‘XY.Rout’ to ‘XY.Rout.save’ ... OK + Running ‘antifoul.R’ + Comparing ‘antifoul.Rout’ to ‘antifoul.Rout.save’ ... OK + Running ‘pyrithione.R’ + Comparing ‘pyrithione.Rout’ to ‘pyrithione.Rout.save’ ... OK + OK * checking PDF version of manual ... OK * DONE diff --git a/docs/index.html b/docs/index.html index 3ad6d4a..f6c1903 100644 --- a/docs/index.html +++ b/docs/index.html @@ -45,15 +45,15 @@
A somewhat outdated package of basic and easy-to-use functions for fitting dose-response curves to continuous dose-response data, calculating some - (eco)toxicological parameters and plotting the results. Please consider using + toxicological parameters and plotting the results. Please consider using the more powerful and actively developed 'drc' package. Functions that are fitted are the cumulative density function of the lognormal distribution - (probit fit), of the logistic distribution (logit fit), of the weibull - distribution (weibull fit) and a linear-logistic model ("linlogit" fit), + ('probit' fit), of the logistic distribution ('logit' fit), of the Weibull + distribution ('weibull' fit) and a linear-logistic model ('linlogit' fit), derived from the latter, which is used to describe data showing stimulation at low doses (hormesis). In addition, functions checking, plotting and retrieving - dose-response data retrieved from a database accessed via RODBC are included. - As an alternative to the original fitting methods, the algorithms from the drc + dose-response data retrieved from a database accessed via 'RODBC' are included. + As an alternative to the original fitting methods, the algorithms from the 'drc' package can be used.
diff --git a/docs/reference/antifoul.html b/docs/reference/antifoul.html index 5a2b886..f5bc9fd 100644 --- a/docs/reference/antifoul.html +++ b/docs/reference/antifoul.html @@ -128,7 +128,34 @@ linlogit = TRUE, logit = TRUE, weibull = TRUE, chooseone = FALSE, showED50 = TRUE, EDx = c(10))
#> -#> TBT: Fitting data...
#> Error in ED50["1:50", "Lower"]: Indizierung außerhalb der Grenzen
print(rantifoul.drc, digits = 5)
#> Error in print(rantifoul.drc, digits = 5): Objekt 'rantifoul.drc' nicht gefunden
+#> TBT: Fitting data...
#> +#> Zn Pyrithion: Fitting data...
print(rantifoul.drc, digits = 5)
#> Substance ndl n lld lhd mtype logED50 2.5% 97.5% +#> 1 TBT 38 135 -2.7093 2.3979 linlogit NA NA NA +#> 2 TBT 38 135 -2.7093 2.3979 probit -0.16436 -0.28178 -0.072022 +#> 3 TBT 38 135 -2.7093 2.3979 logit -0.16012 -0.27782 -0.067603 +#> 4 TBT 38 135 -2.7093 2.3979 weibull -0.13012 -0.23786 -0.043860 +#> 5 Zn Pyrithion 27 81 -2.1072 2.0000 linlogit -0.41330 -0.54457 -0.312631 +#> 6 Zn Pyrithion 27 81 -2.1072 2.0000 probit -0.39792 -0.52005 -0.302705 +#> 7 Zn Pyrithion 27 81 -2.1072 2.0000 logit -0.40035 -0.52324 -0.304676 +#> 8 Zn Pyrithion 27 81 -2.1072 2.0000 weibull -0.37351 -0.49792 -0.276917 +#> unit sigma a b c ED50 ED50 2.5% ED50 97.5% +#> 1 microM 0.19264 0.71806 1.04061 -0.024169 NA NA NA +#> 2 microM 0.19286 0.68492 -0.64209 NA 0.68492 0.52267 0.84718 +#> 3 microM 0.19199 0.69165 1.05007 NA 0.69165 0.52744 0.85585 +#> 4 microM 0.18900 -0.13012 0.79816 NA 0.74111 0.57828 0.90394 +#> 5 microM 0.22878 0.30926 1.74257 0.611358 0.38610 0.28538 0.48682 +#> 6 microM 0.22866 0.40002 -1.04159 NA 0.40002 0.30196 0.49808 +#> 7 microM 0.22802 0.39779 1.71015 NA 0.39779 0.29975 0.49582 +#> 8 microM 0.23077 -0.37351 1.19152 NA 0.42315 0.31775 0.52855 +#> EDx10 EDx10 2.5% EDx10 97.5% +#> 1 NA NA NA +#> 2 0.093074 0.040308 0.14584 +#> 3 0.085338 0.035963 0.13471 +#> 4 0.069958 0.026197 0.11372 +#> 5 0.120238 0.043513 0.19696 +#> 6 0.116878 0.048151 0.18561 +#> 7 0.110068 0.043085 0.17705 +#> 8 0.087066 0.017958 0.15617
#> +#> Zn Pyrithion: Fitting data...
format(r, digits = 2)
#> Substance ndl n lld lhd mtype logED50 2.5% 97.5% unit sigma a +#> 1 TBT 38 135 -2.7 2.4 probit -0.16 -0.28 -0.072 microM 0.19 0.68 +#> 2 Zn Pyrithion 27 81 -2.1 2.0 probit -0.40 -0.52 -0.303 microM 0.23 0.40 +#> b ED50 ED50 2.5% ED50 97.5% EDx5 EDx5 2.5% EDx5 97.5% EDx10 EDx10 2.5% +#> 1 -0.64 0.68 0.52 0.85 0.053 0.015 0.091 0.093 0.040 +#> 2 -1.04 0.40 0.30 0.50 0.082 0.023 0.142 0.117 0.048 +#> EDx10 97.5% EDx20 EDx20 2.5% EDx20 97.5% +#> 1 0.15 0.18 0.11 0.26 +#> 2 0.19 0.18 0.10 0.26