R/golden_ratio.R

In pracma: Practical Numerical Math Functions

##
##  g o l d e n _ r a t i o .R  Golden Ratio Search
##


golden_ratio <- function(f, a, b, ...,
                         maxiter = 100, tol = .Machine$double.eps^0.5)
# Golden Ratio search for a univariate function minimum in a bounded interval
{
    fun <- match.fun(f)
    f <- function(x) fun(x, ...)

	phi <- 1 - (sqrt(5) - 1)/2
	x <- c(a, a + phi*(b-a), b - phi*(b-a), b)
	y2 <- f(x[2])
	y3 <- f(x[3])
	n <- 0
	while (x[3] - x[2] > tol) {
		n <- n + 1
		if (y3 > y2) {
			x <- c(x[1], x[1]+phi*(x[3]-x[1]), x[2], x[3])
			y3 <- y2
			y2 <- f(x[2])
		} else {
			x <- c(x[2], x[3], x[4]-phi*(x[4]-x[2]), x[4])
			y2 <- y3
			y3 <- f(x[3])
		}
		if (n >= maxiter) break
	}
	xm <- (x[2]+x[3])/2
	fxm <- if (abs(f(xm)) <= tol^2) 0.0 else f(xm)
	return(list(xmin=xm, fmin=fxm, iter=n, estim.prec=abs(x[3]-x[2])))
}