Revision 9db5cb10e6504bf07dee9dff590abf263209d7c1 authored by Andrej-Nikolai Spiess on 08 August 1977, 00:00:00 UTC, committed by Gabor Csardi on 08 August 1977, 00:00:00 UTC
0 parent
Raw File
expGrowth.R
expGrowth <- function (fixed = c(NA, NA, NA), names = c("span", "K", "plateau")) 
{
    numParm <- 3
    if (!is.character(names) | !(length(names) == numParm)) {
        stop("Not correct 'names' argument")
    }
    if (!(length(fixed) == numParm)) {
        stop("Not correct 'fixed' argument")
    }
    notFixed <- is.na(fixed)
    parmVec <- rep(0, numParm)
    parmVec[!notFixed] <- fixed[!notFixed]
    fct <- function(x, parm) {
        parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE)
        parmMat[, notFixed] <- parm
        parmMat[, 1] * exp(parmMat[, 2] * x) + parmMat[, 3]
    }
    ssfct <- function(data) {
        x <- data[, 1]
        y <- data[, 2]
        if (is.na(fixed[3])) {
            plateau <- 0.95 * min(y)
        }
        else {
            plateau <- fixed[3]
        }
        span <- max(y) - plateau
        tempY <- log((y - plateau))
        coefVec <- coef(lm(tempY ~ x))
        span <- exp(coefVec[1])
        K <- coefVec[2]
        return(c(span, K, plateau)[notFixed])
    }
    pnames <- names[notFixed]
    deriv1 <- function(x, parm) {
        parmMat <- matrix(parmVec, nrow(parm), numParm, byrow = TRUE)
        parmMat[, notFixed] <- parm
        helper1 <- exp(parmMat[, 2] * x)
        cbind(helper1, parmMat[, 1] * helper1 * x, 1)
    }
    deriv2 <- NULL
    returnList <- list(fct = fct, ssfct = ssfct, names = pnames, 
        deriv1 = deriv1, deriv2 = deriv2)
    class(returnList) <- "Exponential growth"
    invisible(returnList)
}
back to top