R/abm3.R

In pracma: Practical Numerical Math Functions

abm3pc <- function(f, a, b, y0, n = 50, ...) {
    stopifnot(is.numeric(a), is.numeric(b))
    stopifnot(is.numeric(y0), length(y0) == 1)
    if (!is.numeric(n) || length(n) != 1 || n < 5)
        stop("Argument 'n' must be an integer greater or equal to 5.")

    n <- floor(n)
    fun <- match.fun(f)
    f <- function(x, y) fun(x, y, ...)

    h <- (b-a)/n	
    k <- h/12

    x  <- seq(a, b, by = h)
    z  <- y <- numeric(n+1)
    z[1] <- f(a, y0)
    y[1] <- y0

    # Use midpoint method to start
    k1 <- h * z[1]
    k2 <- h * f(a + h/2, y0 + k1/2)
    k3 <- h * f(a + 0.75*h, y0 + 0.75*k2)
    y[2] <- y0 + (2*k1 +3*k2 + 4*k3)/9
    z[2] <- f(x[2], y[2])

    # Use Runge-Kutta for next step
    k1 <- h * z[2] 
    k2 <- h * f(x[2] + h/2, y[2] + k1/2)
    k3 <- h * f(x[2] + 0.75*h, y[2] + 0.75*k2)
    y[3] <- y[2] + (2*k1 +3*k2 + 4*k3)/9
    z[3] <- f(x[2], y[2])

    zz <- yy <- numeric(n)
    errorest <- numeric(n)

    # Use 3rd order A-B-M method for the remaining points
    # yy is the predicted, y the corrected value
    for (i in 3:n) {
       yy[i+1] <- y[i] + k * (23*z[i] - 16*z[i-1] + 5*z[i-2])
       zz[i+1] <- f(x[i+1], yy[i+1])
       y[i+1]  <- y[i] + k * (5*zz[i+1] + 8*z[i] - z[i-1])
       z[i+1]  <- f(x[i+1], y[i+1])

       # Error estimation
       errorest[i+1] <- -0.1 * (y[i+1] - yy[i+1])
    }

    errorest <- sqrt(abs(errorest))
    return(list(x = x, y = y, est.error = errorest))
}