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(m,
    xunit="",yunit="",measurand="",
    level=0.95)
{
    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.calm <- function(m,measurements)
{
    s <- summary(m)    
    xi <- m$model$x
    yi <- m$model$y
    n <- length(yi)
    yobs <- newdata[[1]]
    p <- length(yobs)
    if (!m$intercept)
    {
        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["xi","Estimate"]
        xpred <- (mean(yobs) - b0)/b1
        sumxxbar <- sum((xi - mean(xi))^2) 
        if (!syobs)
        {
            yybar <- (mean(yobs) - mean(yi))^2
            sdxpred <- (S/b1) * (1/p + 1/n + yybar/(b1^2 * sumxxbar))^0.5
        } else
        {
            sdxpred <- ((varyobs^0.5/b1) + (S/b1)^2 * (1/n + ((xpred - mean(xi))^2)/sumxxbar))^0.5
        }
    }
    t <- qt((1 + level)/2,ntot - 2)
    confxpred <- t * sdxpred

    result <- c(estimate=xpred,sdxpred=sdxpred,syobs=syobs,
        confxpred=confxpred)
    digits <- max(c(3,round(log10(xpred/confxpred)) + 2))
    roundedresult <- round(result,digits=digits)
    confidenceinterval <- paste(roundedresult["estimate"],"+-",
        roundedresult["confxpred"],xunit)
    roundedresult[["confidenceinterval"]] <- confidenceinterval
    invisible(roundedresult)
}
calpredict <- function(yobs,xi,yi,xunit="",level=0.95,intercept=FALSE,syobs=FALSE)
{
    if (length(xi)!=length(yi))
    {
        cat("xi and yi have to be of the same length\n")
    }
    xi <- xi[!is.na(yi)]
    yi <- yi[!is.na(yi)]
    n <- length(yi)
    p <- length(yobs)
    if (!intercept)
    {
        m <- lm(yi ~ xi - 1)
    } else 
    {
        m <- lm(yi ~ xi)
    }
    S <- summary(m)$sigma
    b1 <- summary(m)$coef["xi","Estimate"]

    if (syobs)
    {
        if (is.numeric(syobs))
        {
            varyobs <- syobs^2
            ntot <- n
        } else
        {
            if (length(yobs)==1)
            {
                cat("yobs has to contain more than one number vector, if you use syobs=TRUE\n")
            }
            varyobs <- var(yobs)
            ntot <- n + p
        }
    } else
    {
        varyobs <- S^2
        ntot <- n
    }

    if (!intercept)
    {
        varb1 <- summary(m)$coef["xi","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["xi","Estimate"]
        xpred <- (mean(yobs) - b0)/b1
        sumxxbar <- sum((xi - mean(xi))^2) 
        if (!syobs)
        {
            yybar <- (mean(yobs) - mean(yi))^2
            sdxpred <- (S/b1) * (1/p + 1/n + yybar/(b1^2 * sumxxbar))^0.5
        } else
        {
            sdxpred <- ((varyobs^0.5/b1) + (S/b1)^2 * (1/n + ((xpred - mean(xi))^2)/sumxxbar))^0.5
        }
    }
    t <- qt((1 + level)/2,ntot - 2)
    confxpred <- t * sdxpred

    result <- c(estimate=xpred,sdxpred=sdxpred,syobs=syobs,
        confxpred=confxpred)
    digits <- max(c(3,round(log10(xpred/confxpred)) + 2))
    roundedresult <- round(result,digits=digits)
    confidenceinterval <- paste(roundedresult["estimate"],"+-",
        roundedresult["confxpred"],xunit)
    roundedresult[["confidenceinterval"]] <- confidenceinterval
    invisible(roundedresult)
}

multical <- function(cf,df,intercept=FALSE)
{
    rf <- data.frame(name=levels(df$name))
    substances <- colnames(df)[-1]
    for (s in substances)
    {
        r <- vector()
        for (sample in levels(df$name))
        {
            tmp <- calpredict(subset(df,name==sample)[[s]],
                cf[["conc"]],cf[[s]],
                intercept=intercept)
            r <- c(r,tmp[["confidenceinterval"]])
        }
        rf[[s]] <- r
    }
    return(rf)
}