wikipedia:en:Rosenbrock_functionという有名らしい関数があるんですが、共役勾配法の動きを見てみるためにこの関数で遊んでみました。結果はこんな感じ。
極端すぎないパラメータだと大域的最適解に行ってくれました。コードも簡単。
f <- function(x) { x1 <- x[1]; x2 <- x[2] (1 - x1)^2 + 100 * (x2 - x1^2)^2 } nabla_f <- function(x) { x1 <- x[1]; x2 <- x[2] c(2 * (x1 - 1) + 400 * x1 * ((x1^2 - x2)), 200 * (x2 - x1^2)) } armijo <- function(x, d, xi, tau) { beta <- 1 while(f(x + beta * d) > f(x) + xi * beta * sum(nabla_f(x) * d)) { beta <- tau * beta } return(beta) } plot.banana.function <- function(init, xi, tau) { x0 <- init d <- - nabla_f(x0) x <- x0 k <- 1 result <- matrix(x, 1, 2, byrow=TRUE) while(TRUE){ old_nabla_f <- sum(nabla_f(x)^2) old_x <- x x <- x + armijo(x, d, xi, tau) * d result <- rbind(result, x) if(sum((x - old_x)^2) < 0.00001) break beta <- sum(nabla_f(x)^2) / old_nabla_f d <- - nabla_f(x) + beta * d k <- k + 1 } x <- seq(-2, 2, length.out=20) y <- seq(-1, 3, length.out=20) z <- outer(x, y, function(x1, x2) (1 - x1)^2 + 100 * (x2 - x1^2)^2) contour(x, y, z, main = paste("xi = ", xi, ", tau = ", tau, sep=""), xlab = "x1", ylab = "x2", ) lines(result[,1], result[,2], col = "red", lwd = 2, type = "o") } par(mfrow=c(3, 3)) init <- c(2, -1) for(xi in c(0.1, 0.3, 0.75)) { for(tau in c(0.1, 0.3, 0.75)) { plot.banana.function(init, xi, tau) } }
共役勾配法は二次関数の場合では、変数分の反復で収束してくれるという性質がありますが、今回のはそういう関数ではないので、簡単には収束しません。
去年はこれの3Dバジョーンで最急降下法でやってました。