# tests/scbdtest.R In optimrx: Expanded Replacement and Extension of the 'optim' Function

```rm(list=ls())
# fname<-paste(format(Sys.time(), "%Y%m%d%H%M"),"-btRvmmin.out",sep='')
# sink(fname, append=TRUE, split=TRUE)
require("optimrx")
#####################

# This test script illustrates the use of bounds in optimr()
# where there is significant variation in the scaling of the parameters.

sfactor <- 4.0

# Scaled bounds test
sbt.f<-function(x){
nn <- length(x)
y <- sfactor^(0:(nn - 1))
sum((x - y)^2)
}

sbt.g<-function(x){
nn <- length(x)
y <- sfactor^(0:(nn - 1))
gg<-2.0*(x - y)
}

n<-4
lower<-rep(0,n)
upper<-lower # to get arrays set
bdmsk<-rep(1,n)
y <- sfactor^(0:(n - 1))
upper <- 0.8*y # to force active constraints

xx <- lower + 0.1*(lower + upper) # start a bit up from lower bounds

cat("Rvmmin \n\n")

abtrvm <- optimr(xx, sbt.f, sbt.g, lower, upper, method="Rvmmin", control=list(trace=1))
print(abtrvm)

alb<-optimr(xx, sbt.f, sbt.g, lower=lower, upper=upper, method="L-BFGS-B", control=list(trace=1))
print(alb)

sabtrvm <- optimr(xx, sbt.f, sbt.g, lower, upper, method="Rvmmin", control=list(trace=1, parscale=c(1,4,16,32)))
print(sabtrvm)

salb<-optimr(xx, sbt.f, sbt.g, lower=lower, upper=upper, method="L-BFGS-B", control=list(trace=1, parscale=c(1,4,16,32)))
print(salb)

alkkt <- optextras::kktchk(alb\$par, sbt.f, sbt.g, hess=NULL, upper=upper, lower=lower,  maxfn=FALSE,  control=list(trace=1))
print(alkkt)

salkkt <- optextras::kktchk(salb\$par, sbt.f, sbt.g, hess=NULL, upper=upper, lower=lower,  maxfn=FALSE,  control=list(trace=1))
print(salkkt)

aallbd <- opm(xx, sbt.f, sbt.g, lower=lower, upper=upper, method="ALL", control=list(trace=0))
print(aallbd)

saallbd <- opm(xx, sbt.f, sbt.g, lower=lower, upper=upper, method="ALL", control=list(trace=0, parscale=c(1,4,16,32)))
print(saallbd)

#sink()
```

## Try the optimrx package in your browser

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

optimrx documentation built on May 2, 2019, 4:41 p.m.