aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2017-03-24 15:24:04 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2017-03-24 15:24:04 +0100
commit22c11d5dbc118881f9cfd7c9c2ac9711295a0f16 (patch)
treea2c88069b82633027047c60bf656e53c4b561182
parentb05f8438729e8070f4e0cbbf628bbbcbbe3f1a7a (diff)
Suppress error messages in dr(c)fit, maintenance
- Checking examples fails if error messages in dr(c)fit stemming from failed fits are printed - Delete trailing whitespace - Update packaging
-rw-r--r--.Rbuildignore1
-rw-r--r--.gitignore2
-rw-r--r--DESCRIPTION6
-rw-r--r--NAMESPACE2
-rw-r--r--R/checkexperiment.R30
-rw-r--r--R/checksubstance.R54
-rw-r--r--R/drcfit.R31
-rw-r--r--R/drdata.R4
-rw-r--r--R/drfit.R47
-rw-r--r--R/drplot.R36
10 files changed, 115 insertions, 98 deletions
diff --git a/.Rbuildignore b/.Rbuildignore
index 7e262d7..91c0bbb 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -6,3 +6,4 @@ blg$
aux$
log$
test.R
+^docs/*
diff --git a/.gitignore b/.gitignore
index 9484aca..18c7c89 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1 +1,3 @@
test.R
+drfit*.tar.gz
+drfit.Rcheck
diff --git a/DESCRIPTION b/DESCRIPTION
index 61c9551..173e9c6 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,10 +1,10 @@
Package: drfit
-Version: 0.6.5
-Date: 2015-12-15
+Version: 0.7.1
+Date: 2017-03-24
Title: Dose-Response Data Evaluation
Authors@R: c(person("Johannes", "Ranke", role = c("aut", "cre"),
email = "jranke@uni-bremen.de"))
-Imports: graphics, grDevices, MASS, drc
+Imports: graphics, grDevices, MASS, drc, reshape2, qcc
Suggests: RODBC
Description: A somewhat outdated package of basic and easy-to-use functions for
fitting dose-response curves to continuous dose-response data, calculating some
diff --git a/NAMESPACE b/NAMESPACE
index 91a4d4a..120d052 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -8,3 +8,5 @@ import(
)
importFrom("drc", drm, ED, LN.2, LL.2, BC.4, W1.2)
+importFrom("reshape2", melt, acast)
+importFrom("qcc", qcc)
diff --git a/R/checkexperiment.R b/R/checkexperiment.R
index b264243..b69b81f 100644
--- a/R/checkexperiment.R
+++ b/R/checkexperiment.R
@@ -9,7 +9,7 @@ checkexperiment <- function(id, db = "ecotox", endpoint = "%")
if (!(db %in% rownames(databases))) stop("Database is not supported")
- if (require("RODBC")) {
+ if (requireNamespace("RODBC")) {
channel <- RODBC::odbcConnect(db, uid="cytotox", pwd="cytotox", case="tolower")
} else {
stop("For this function, the RODBC package has to be installed and configured.")
@@ -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 790182f..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"),
@@ -11,7 +11,7 @@ checksubstance <- function(substance, db = "cytotox", experimentator = "%",
if (!(db %in% rownames(databases))) stop("Database is not supported")
- if (require("RODBC")) {
+ if (requireNamespace("RODBC")) {
channel <- RODBC::odbcConnect(db, uid="cytotox", pwd="cytotox", case="tolower")
} else {
stop("For this function, the RODBC package has to be installed and configured.")
@@ -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 8c52f6d..0d27c1c 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
@@ -69,7 +69,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
@@ -90,10 +91,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["1:50", "Estimate"])
logED50low[[ri]] <- log10(ED50["1:50", "Lower"])
@@ -101,14 +103,14 @@ 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
@@ -142,7 +144,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
@@ -179,7 +182,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
@@ -252,7 +256,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 = "")
@@ -275,12 +279,13 @@ 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)] <- EDx.drc[paste0("1:", EDi), "Estimate"]
- results[row.i, paste0("EDx", EDi, " ", lower_level_percent)] <- EDx.drc[paste0("1:", EDi),
+ results[row.i, paste0("EDx", EDi, " ", lower_level_percent)] <- EDx.drc[paste0("1:", EDi),
"Lower"]
- results[row.i, paste0("EDx", EDi, " ", upper_level_percent)] <- EDx.drc[paste0("1:", EDi),
+ results[row.i, paste0("EDx", EDi, " ", upper_level_percent)] <- EDx.drc[paste0("1:", EDi),
"Upper"]
}
}
diff --git a/R/drdata.R b/R/drdata.R
index eda1249..dc741a6 100644
--- a/R/drdata.R
+++ b/R/drdata.R
@@ -3,7 +3,7 @@ drdata <- function(substances, experimentator = "%", db = "cytotox",
organism = "Vibrio fischeri", endpoint = "Luminescence", whereClause = "1",
ok = "'ok','no fit'")
{
- if (require("RODBC")) {
+ if (requireNamespace("RODBC")) {
channel <- RODBC::odbcConnect(db,uid="cytotox",pwd="cytotox",case="tolower")
slist <- paste(substances,collapse="','")
if (db == "cytotox") {
@@ -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)
}
}

Contact - Imprint