swh:1:snp:81eadaa089e8253d8469bcef66aa332632c6c669
Tip revision: 3f1c6b45c918375fc2b65bb2a7d6e3590979cb61 authored by HwB on 12 December 2011, 00:00:00 UTC
version 0.9.1
version 0.9.1
Tip revision: 3f1c6b4
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])))
}