Raw File
findzeros.R
findzeros <- function(f, a, b, n = 100, tol = .Machine$double.eps^(2/3), ...) {
    stopifnot(is.numeric(a), length(a) == 1,
              is.numeric(b), length(b) == 1,
              is.numeric(n), floor(n) == ceiling(n), n >= 2)
    if (! a < b)
        stop("Left interval border must be smaller than right one.")

    fun <- match.fun(f)
    f <- function(x) fun(x, ...)

	h <- (b - a) / n
	x <- seq(a, b, by = h)  # length(x) == n+1

    if (abs(f(x[1])) < tol/10) R <- c(x[1])
    else              R <- c()

	for (i in 2:n) {
        if (f(x[i-1]) * f(x[i]) < 0) {
		    u <- uniroot(f, c(x[i-1], x[i]))
		    R <- c(R, u$root)
		}
		s <- (f(x[i]) - f(x[i-1])) * (f(x[i+1]) - f(x[i]))
		if (abs(f(x[i])) < tol && s < 0) {
			R <- c(R, x[i])
		}
	}

    if (abs(f(x[n+1])) < tol/10) R <- c(R, x[n+1])

	return(R)
}


findmins <- function(f, a, b, n = 100, tol = .Machine$double.eps^(2/3), ...) {
    stopifnot(is.numeric(a), length(a) == 1,
              is.numeric(b), length(b) == 1,
              is.numeric(n), floor(n) == ceiling(n), n >= 2)
    if (! a < b)
        stop("Left interval border must be smaller than right one.")

    fun <- match.fun(f)
    f <- function(x) fun(x, ...)

	h <- (b - a) / n
	x <- seq(a, b, by = h)  # length(x) == n+1

    R <- c()

    for (i in 2:(n-1)) {
        if ( (f(x[i]) - f(x[i-1]) < 0) && (f(x[i+1]) - f(x[i])) > 0 ) {
            o <- optimize(f, c(x[i-1], x[i+1]))
            R <- c(R, o$minimum)
        }
    }

    return(R)
}
back to top