demo/genrose_test.R In Rvmminx: Variable metric nonlinear function minimization with bounds constraints - experimental

```## Optimization test function GENROSE
## ?? refs (put in .doc??)
rm(list=ls())
library(Rvmmin1104)

genrose.f<- function(x, gs=NULL){ # objective function
## One generalization of the Rosenbrock banana valley function (n parameters)
n <- length(x)
if(is.null(gs)) { gs=100.0 }
fval<-1.0 + sum (gs*(x[1:(n-1)]^2 - x[2:n])^2 + (x[2:n] - 1)^2)
return(fval)
}

genrose.g0 <- function(x, gs=NULL){
# gradient for genrosef, genrose.f / genrosep.f
n <- length(x)
if(is.null(gs)) { gs=100.0 }
gg<-as.vector(rep(0, n))
for (i in 2:n) {
z1<-x[i]-x[i-1]*x[i-1]
z2<-1.0-x[i]
gg[i]<-2.0*(gs*z1-z2)
gg[i-1]<-gg[i-1]-4.0*gs*x[i-1]*z1
}
return(gg)
}

genrose.h <- function(x, gs=NULL) { ## compute Hessian
if(is.null(gs)) { gs=100.0 }
n <- length(x)
hh<-matrix(rep(0, n*n),n,n)
for (i in 2:n) {
z1<-x[i]-x[i-1]*x[i-1]
z2<-1.0-x[i]
hh[i,i]<-hh[i,i]+2.0*(gs+1.0)
hh[i-1,i-1]<-hh[i-1,i-1]-4.0*gs*z1-4.0*gs*x[i-1]*(-2.0*x[i-1])
hh[i,i-1]<-hh[i,i-1]-4.0*gs*x[i-1]
hh[i-1,i]<-hh[i-1,i]-4.0*gs*x[i-1]
}
return(hh)
}

genrose.doc <- function() { ## documentation for genrose
cat("One generalization of the Rosenbrock banana valley function (n parameters)\n")
## How should we do the documentation output?
}

genrose.g <- function(x, gs=NULL){
n <- length(x)
if(is.null(gs)) { gs=100.0 }
gg <- as.vector(rep(0, n))
tn <- 2:n
tn1 <- tn - 1
z1 <- x[tn] - x[tn1]^2
z2 <- 1 - x[tn]
gg[tn] <- 2 * (gs * z1 - z2)
gg[tn1] <- gg[tn1] - 4 * gs * x[tn1] * z1
gg
}

##  Some timing results
## xx<-rep(2,500)
##k100v<-system.time(gra<-genrose.g(xx,gs=100.0))
##k100v0<-system.time(gra<-genrose.g0(xx,gs=100.0))
##  k100v
##    user  system elapsed
##    0.068   0.016   0.084
##  k100v0
##     user  system elapsed
##    3.188   0.004   3.198
##

xx<-rep(2,50)
t1k<-system.time(ans<-Rvmminstep(xx,genrose.f,genrose.g0,control=list(trace=1),gs=100.0))[1]
cat("final fn value =",ans\$value,"\n")
cat("time = ",t1k,"\n")

xx<-rep(2,50) # reduce to 50 from 500 20100525 to reduce testing time
n<-length(xx)
bdmsk<-c(rep(0,10),rep(1,(n-10)))
ll<-rep(-20,n)
uu<--ll
t1000m<-system.time(ans<-Rvmminstep(xx,genrose.f,genrose.g0,lower=ll, upper=uu,bdmsk=bdmsk,control=list(trace=1),gs=100.0))[1]
cat("final fn value =",ans\$value,"\n")
cat("time = ",t1000m,"\n")
```

Try the Rvmminx package in your browser

Any scripts or data that you put into this service are public.

Rvmminx documentation built on May 2, 2019, 4:47 p.m.