线性搜索的最速上升法
####
max.search <- function(f, x, y, tol=1e-9, a.max = 2^5){
if(sum(abs(y)) == 0) return(x)
g <- function(a) return(f(x+a*y))
a.l <- 0
g.l <- g(a.l)
a.m <- 1
g.m <- g(a.m) while((g.m < g.l)&(a.m > tol)){
a.m <- a.m/2
g.m <- g(a.m)
}
if((a.m <- tol) & (g.m < g.l)) return (x)
a.r <- 2*a.m
g.r <- g(a.r)
while((g.m < g.r) & (a.r < a.max)){
a.m <- a.r
g.m <- g.r
a.r <- 2*a.max
g.r <- h(a.r)
}
if((a.r >= a.max) & (g.m < g.r)) return(x+a.max*y)
a <- gsection(g, a.l, a.r, a.m)
return(x + a*y)
} ####gsection
gsection <- function(ftn, x.l, x.r, x.m, tol=1e-9){
###黄金分割率
gr1 <- 1 + (1+sqrt(5))/2
f.l <- ftn(x.l)
f.r <- ftn(x.r)
f.m <- ftn(x.m)
while((x.r - x.l) > tol){
if((x.r - x.m) > (x.m - x.l)){
y <- x.m + (x.r - x.m)/grl
f.y <- ftn(y)
if(f.y >= f.m){
x.l <- x.m
f.l <- f.m
x.m <- y
f.m <- f.y
}
else{
x.r <- y
f.r <- f.y
}
}else{
y <- x.m - (x.m - x.l)/grl
f.y <- ftn(y)
if(f.y >= f.m){
x.r <- x.m
f.r <- f.m
x.m <- y
f.m <- f.y
}
else{
x.l <- y
f.l <- f.y
}
}
}
return(x.m)
}