aboutsummaryrefslogtreecommitdiff
path: root/branches/0.1/chemCal/R/calplot.R
diff options
context:
space:
mode:
Diffstat (limited to 'branches/0.1/chemCal/R/calplot.R')
-rw-r--r--branches/0.1/chemCal/R/calplot.R80
1 files changed, 80 insertions, 0 deletions
diff --git a/branches/0.1/chemCal/R/calplot.R b/branches/0.1/chemCal/R/calplot.R
new file mode 100644
index 0000000..6aed9c0
--- /dev/null
+++ b/branches/0.1/chemCal/R/calplot.R
@@ -0,0 +1,80 @@
+calplot <- function(object,
+ xlim = c("auto", "auto"), ylim = c("auto", "auto"),
+ xlab = "Concentration", ylab = "Response", alpha = 0.05,
+ varfunc = NULL)
+{
+ UseMethod("calplot")
+}
+
+calplot.default <- function(object,
+ xlim = c("auto","auto"), ylim = c("auto","auto"),
+ xlab = "Concentration", ylab = "Response",
+ alpha=0.05, varfunc = NULL)
+{
+ stop("Calibration plots only implemented for univariate lm objects.")
+}
+
+calplot.lm <- function(object,
+ xlim = c("auto","auto"), ylim = c("auto","auto"),
+ xlab = "Concentration", ylab = "Response", alpha=0.05,
+ varfunc = NULL)
+{
+ if (length(object$coef) > 2)
+ stop("More than one independent variable in your model - not implemented")
+
+ if (alpha <= 0 | alpha >= 1)
+ stop("Alpha should be between 0 and 1 (exclusive)")
+
+ m <- object
+ level <- 1 - alpha
+ y <- m$model[[1]]
+ x <- m$model[[2]]
+ if (xlim[1] == "auto") xlim[1] <- 0
+ if (xlim[2] == "auto") xlim[2] <- max(x)
+ xlim <- as.numeric(xlim)
+ newdata <- list(
+ x = seq(from = xlim[[1]], to = xlim[[2]], length=250))
+ names(newdata) <- names(m$model)[[2]]
+ if (is.null(varfunc)) {
+ varfunc <- if (length(m$weights)) {
+ function(variable) mean(m$weights)
+ } else function(variable) rep(1,250)
+ }
+ pred.lim <- predict(m, newdata, interval = "prediction",
+ level=level, weights.newdata = varfunc(m))
+ conf.lim <- predict(m, newdata, interval = "confidence",
+ level=level)
+ yrange.auto <- range(c(0,pred.lim))
+ if (ylim[1] == "auto") ylim[1] <- yrange.auto[1]
+ if (ylim[2] == "auto") ylim[2] <- yrange.auto[2]
+ plot(1,
+ type = "n",
+ xlab = xlab,
+ ylab = ylab,
+ xlim = as.numeric(xlim),
+ ylim = as.numeric(ylim)
+ )
+ points(x,y, pch = 21, bg = "yellow")
+ matlines(newdata[[1]], pred.lim, lty = c(1, 4, 4),
+ col = c("black", "red", "red"))
+ if (length(object$weights) > 0) {
+ legend(min(x),
+ max(pred.lim, na.rm = TRUE),
+ legend = c("Fitted Line", "Confidence Bands"),
+ lty = c(1, 3),
+ lwd = 2,
+ col = c("black", "green4"),
+ horiz = FALSE, cex = 0.9, bg = "gray95")
+ } else {
+ matlines(newdata[[1]], conf.lim, lty = c(1, 3, 3),
+ col = c("black", "green4", "green4"))
+ legend(min(x),
+ max(pred.lim, na.rm = TRUE),
+ legend = c("Fitted Line", "Confidence Bands",
+ "Prediction Bands"),
+ lty = c(1, 3, 4),
+ lwd = 2,
+ col = c("black", "green4", "red"),
+ horiz = FALSE, cex = 0.9, bg = "gray95")
+ }
+}

Contact - Imprint