calm <- function(data) { y <- data[[2]] x <- data[[1]] m <- lm(y ~ x) s <- summary(m) if (s$coefficients[1,4] > 0.05) { m <- lm(y ~ x - 1) s <- summary(m) m$intercept <- FALSE } else { m$intercept <- TRUE } class(m) <- "calm" m$yname <- names(data)[[1]] m$xname <- names(data)[[2]] return(m) } predict.calm <- predict.lm print.calm <- print.lm summary.calm <- summary.lm plot.calm <- function(x,..., xunit="",yunit="",measurand="", level=0.95) { m <- x x <- m$model$x y <- m$model$y newdata <- data.frame(x = seq(0,max(x),length=250)) pred.lim <- predict(m, newdata, interval = "prediction",level=level) conf.lim <- predict(m, newdata, interval = "confidence",level=level) if (xunit!="") { xlab <- paste("Concentration in ",xunit) } else xlab <- m$xname if (yunit=="") yunit <- m$yname if (measurand!="") { main <- paste("Calibration for",measurand) } else main <- "Calibration" plot(1, xlab = xlab, ylab = yunit, type = "n", main = main, xlim = c(0,max(x)), ylim = range(pred.lim) ) points(x,y, pch = 21, bg = "yellow") matlines(newdata$x, pred.lim, lty = c(1, 4, 4), col = c("black", "red", "red")) matlines(newdata$x, 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") } predictx <- function(m,yobs,level=0.95) { s <- summary(m) xi <- m$model$x yi <- m$model$y n <- length(yi) p <- length(yobs) if (p > 1) { varyobs <- var(yobs) } else { varyobs <- 0 } if (!m$intercept) { b1 <- summary(m)$coef["x","Estimate"] varb1 <- summary(m)$coef["x","Std. Error"]^2 xpred <- mean(yobs)/b1 varxpred <- (varyobs + xpred^2 * varb1) / b1^2 sdxpred <- sqrt(varxpred) } else { b0 <- summary(m)$coef["(Intercept)","Estimate"] b1 <- summary(m)$coef["x","Estimate"] S <- summary(m)$sigma xpred <- (mean(yobs) - b0)/b1 sumxxbar <- sum((xi - mean(xi))^2) yybar <- (mean(yobs) - mean(yi))^2 sdxpred <- (S/b1) * (1/p + 1/n + yybar/(b1^2 * sumxxbar))^0.5 } t <- qt((1 + level)/2,n - 2) confxpred <- t * sdxpred result <- c(estimate=xpred,sdxpred=sdxpred,confxpred=confxpred) }