R/fibsearch.R

In pracma: Practical Numerical Math Functions

##
##  f i b s e a r c h . R  Fibonacci Search
##


fibsearch <- function(f, a, b, ...,
					  endp = FALSE, tol = .Machine$double.eps^(1/2))
# Fibonacci search for a univariate function minimum in a bounded interval
{
	if (a >= b) stop("Left endpoint a must be smaller than b.")
	tol <- max(tol, .Machine$double.eps)

	# Compute Fibonacci numbers [F0,] F1, F2, ..., Fm
	F <- c(1, 2); n <- 2
	while (F[n] <= 2*(b-a)/tol) { F[n+1] <- F[n] + F[n-1]; n <- n + 1 }

	# Initialize values (k == 0)
	x1 <- a; x2 <- b
	xa <- a + (b-a) * F[n-2]/F[n]; fxa <- f(xa, ...)
	xb <- a + (b-a) * F[n-1]/F[n]; fxb <- f(xb, ...)

	# Compute iteration
	k <- 1
	while (k <= n-3 && xa < xb && (x2 - x1) >= tol) {
		if (fxa > fxb) {
			x1 <- xa; xa <- xb
			xb <- x1 + (x2-x1) * F[n-k-1]/F[n-k]
			fxa <- fxb; fxb <- f(xb, ...)
		} else {
			x2 <- xb; xb <- xa
			xa <- x1 + (x2-x1) * F[n-k-2]/F[n-k]
			fxb <- fxa; fxa <- f(xa, ...)
		}
		k <- k + 1
	}

	# Finally use the mean and consider endpoints
	xmin <- (xa+xb)/2; fmin <- f(xmin, ...)
	if (endp) {
		fa <- f(a, ...); fb <- f(b, ...)
		if (xmin-a < tol && fa < fmin) {
			xmin <- a; fmin <- fa
		} else {
			if (b - xmin < tol && fb < fmin) {
				xmin <- b; fmin <- fb
			}
		}
	}
	estim.prec <- max(xmin-x1, x2-xmin)
	return(list(xmin=xmin, fmin=fmin, niter=k, estim.prec=estim.prec))
}