swh:1:snp:81eadaa089e8253d8469bcef66aa332632c6c669
Tip revision: fdf16693b000f3e309c56091892c61f0ec9fd670 authored by Hans W. Borchers on 21 November 2017, 16:15:00 UTC
version 2.1.1
version 2.1.1
Tip revision: fdf1669
golden_ratio.R
##
## 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])))
}