From f92cc2ed89ea77d206866231247cc5fa28e564ed Mon Sep 17 00:00:00 2001 From: ranke Date: Thu, 24 Feb 2005 14:53:32 +0000 Subject: I added the possibility to select one from the possible fits in the drfit function, so only one fit is reported per substance. git-svn-id: http://kriemhild.uft.uni-bremen.de/svn/drfit@12 d1b72e20-2ee0-0310-a1c4-ad5adbbefcdc --- DESCRIPTION | 2 +- R/drfit.R | 111 +++++++++++++++++++++++++++++++--------------------------- man/drdata.Rd | 3 +- man/drfit.Rd | 7 +++- 4 files changed, 69 insertions(+), 54 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4069afd..95f71d7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: drfit -Version: 0.03-10 +Version: 0.03-12 Date: 2004-09-16 Title: Dose-response data evaluation Author: Johannes Ranke diff --git a/R/drfit.R b/R/drfit.R index 20f4426..70e05df 100644 --- a/R/drfit.R +++ b/R/drfit.R @@ -51,6 +51,7 @@ drfit <- function(data, startlogEC50 = NA, chooseone=TRUE, splitted <- split(data,data$substance) for (i in substances) { tmp <- splitted[[i]] + fit <- FALSE if (length(tmp$response) == 0) { nodata = TRUE } else { @@ -73,29 +74,31 @@ drfit <- function(data, startlogEC50 = NA, chooseone=TRUE, if (responseathighestdose < 0.5) { inactive <- FALSE - if (lognorm) { - m <- try(nls(response ~ pnorm(-log10(dose),-logEC50,slope), - data=tmp, - start=list(logEC50=startlogEC50[[i]],slope=1))) + if (linearlogis) { + m <- try(nls(response ~ linearlogisf(dose,1,f,logEC50,b), + data=tmp, + start=list(f=f0,logEC50=startlogEC50[[i]],b=b0))) if (!inherits(m, "try-error")) { - s <- summary(m) + fit <- TRUE ri <- ri + 1 + s <- summary(m) sigma[[ri]] <- s$sigma rsubstance[[ri]] <- i rn[[ri]] <- n rlld[[ri]] <- log10(lowestdose) rlhd[[ri]] <- log10(highestdose) - mtype[[ri]] <- "lognorm" + mtype[[ri]] <- "linearlogis" logEC50[[ri]] <- coef(m)[["logEC50"]] - b[[ri]] <- NA - f[[ri]] <- NA + slope[[ri]] <- NA if (logEC50[[ri]] > rlhd[[ri]]) { logEC50[[ri]] <- NA - slope[[ri]] <- NA stderrlogEC50[[ri]] <- NA + b[[ri]] <- NA + f[[ri]] <- NA } else { - slope[[ri]] <- coef(m)[["slope"]] stderrlogEC50[[ri]] <- s$parameters["logEC50","Std. Error"] + b[[ri]] <- coef(m)[["b"]] + f[[ri]] <- coef(m)[["f"]] } } } @@ -106,56 +109,62 @@ drfit <- function(data, startlogEC50 = NA, chooseone=TRUE, m <- try(nls(response ~ plogis(-log10(dose),-logEC50,slope), data=tmp, start=list(logEC50=startlogEC50[[i]],slope=1))) - if (!inherits(m, "try-error")) { - s <- summary(m) - ri <- ri + 1 - rsubstance[[ri]] <- i - rn[[ri]] <- n - rlld[[ri]] <- log10(lowestdose) - rlhd[[ri]] <- log10(highestdose) - mtype[[ri]] <- "logis" - sigma[[ri]] <- s$sigma - logEC50[[ri]] <- coef(m)[["logEC50"]] - b[[ri]] <- NA - f[[ri]] <- NA - if (logEC50[[ri]] > rlhd[[ri]]) { - logEC50[[ri]] <- NA - slope[[ri]] <- NA - stderrlogEC50[[ri]] <- NA - } else { - slope[[ri]] <- coef(m)[["slope"]] - stderrlogEC50[[ri]] <- s$parameters["logEC50","Std. Error"] + if (chooseone==FALSE || fit==FALSE) { + if (!inherits(m, "try-error")) { + fit <- TRUE + ri <- ri + 1 + s <- summary(m) + sigma[[ri]] <- s$sigma + rsubstance[[ri]] <- i + rn[[ri]] <- n + rlld[[ri]] <- log10(lowestdose) + rlhd[[ri]] <- log10(highestdose) + mtype[[ri]] <- "logis" + logEC50[[ri]] <- coef(m)[["logEC50"]] + b[[ri]] <- NA + f[[ri]] <- NA + if (logEC50[[ri]] > rlhd[[ri]]) { + logEC50[[ri]] <- NA + slope[[ri]] <- NA + stderrlogEC50[[ri]] <- NA + } else { + slope[[ri]] <- coef(m)[["slope"]] + stderrlogEC50[[ri]] <- s$parameters["logEC50","Std. Error"] + } } } } - if (linearlogis) { - m <- try(nls(response ~ linearlogisf(dose,1,f,logEC50,b), - data=tmp, - start=list(f=f0,logEC50=startlogEC50[[i]],b=b0))) - if (!inherits(m, "try-error")) { - s <- summary(m) - ri <- ri + 1 - rsubstance[[ri]] <- i - rn[[ri]] <- n - rlld[[ri]] <- log10(lowestdose) - rlhd[[ri]] <- log10(highestdose) - mtype[[ri]] <- "linearlogis" - sigma[[ri]] <- s$sigma - logEC50[[ri]] <- coef(m)[["logEC50"]] - slope[[ri]] <- NA - if (logEC50[[ri]] > rlhd[[ri]]) { - logEC50[[ri]] <- NA - stderrlogEC50[[ri]] <- NA + if (lognorm) { + m <- try(nls(response ~ pnorm(-log10(dose),-logEC50,slope), + data=tmp, + start=list(logEC50=startlogEC50[[i]],slope=1))) + if (chooseone==FALSE || fit==FALSE) { + if (!inherits(m, "try-error")) { + fit <- TRUE + ri <- ri + 1 + s <- summary(m) + sigma[[ri]] <- s$sigma + rsubstance[[ri]] <- i + rn[[ri]] <- n + rlld[[ri]] <- log10(lowestdose) + rlhd[[ri]] <- log10(highestdose) + mtype[[ri]] <- "lognorm" + logEC50[[ri]] <- coef(m)[["logEC50"]] b[[ri]] <- NA f[[ri]] <- NA - } else { - stderrlogEC50[[ri]] <- s$parameters["logEC50","Std. Error"] - b[[ri]] <- coef(m)[["b"]] - f[[ri]] <- coef(m)[["f"]] + if (logEC50[[ri]] > rlhd[[ri]]) { + logEC50[[ri]] <- NA + slope[[ri]] <- NA + stderrlogEC50[[ri]] <- NA + } else { + slope[[ri]] <- coef(m)[["slope"]] + stderrlogEC50[[ri]] <- s$parameters["logEC50","Std. Error"] + } } } } + } else { inactive <- TRUE } diff --git a/man/drdata.Rd b/man/drdata.Rd index dd62ff9..f46a4d3 100644 --- a/man/drdata.Rd +++ b/man/drdata.Rd @@ -13,7 +13,8 @@ A string or an array of strings with the substance names for which dose-response data is to be retrieved.} \item{experimentator}{ - The name of the experimentator whose data is to be used.} + The name of the experimentator whose data is to be used. Default is "%", which + means that data from all experimentators are retrieved.} \item{db}{ The database to be used. Currently only "cytotox" of the UFT Department of Bioorganic Chemistry is supported.} diff --git a/man/drfit.Rd b/man/drfit.Rd index f9843f5..30f3fd4 100644 --- a/man/drfit.Rd +++ b/man/drfit.Rd @@ -6,7 +6,7 @@ biometric results for (eco)toxicity evaluation } \usage{ - drfit(data, startlogEC50 = NA, lognorm = TRUE, logis = FALSE, + drfit(data, startlogEC50 = NA, chooseone = TRUE, lognorm = TRUE, logis = FALSE, linearlogis = FALSE, b0 = 2, f0 = 0) } \arguments{ @@ -32,6 +32,11 @@ \item{linearlogis}{ A boolean defining if the linear-logistic function as defined by van Ewijk and Hoekstra 1993 is fitted to the data. Default is FALSE.} + \item{chooseone}{ + If TRUE (default), the models are tried in the order linearlogis, logis and lognorm, + and the first model that produces a valid fit is used. Usually this will be the one + with the lowest residual standard deviation. If FALSE, all models that are set to TRUE + and that can be fitted will be reported.} \item{b0,f0}{ If the linearlogistic model is fitted, b0 and f0 give the possibility to adapt the starting values for the parameters b and f.} -- cgit v1.2.1