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

```## Trig function
# ref??

trig.f <- function(x){
res <- trig.res(x)
f <- sum(res*res)
#  cat("FV=",f," at ")
#  print(x)
f
}

trig.res <- function(x){
n <- length(x)
i <- 1:n
res <- n - sum(cos(x)) + i*(1 - cos(x)) - sin(x)
return(res)
}

trig.jac <- function(x) { # not vectorized. Can it be?
## stop("Not defined")
n <- length(x)
J<-matrix(0,n,n)
for (i in 1:n) {
for (j in 1:n) {
J[i,j]<-sin(x[j]) # we overwrite J[i,i]
}
J[i,i] <- (1+i) * sin(x[i])  - cos(x[i])
}
return(J)
}

trig.g <- function(x) { # unvectorized
n<-length(x)
res<-trig.res(x)
J<-trig.jac(x)
g<- as.vector(2.0 * ( t(J) %*% res ))
return(g)
}

require(optimrx)
x<-rep(2,2)
cat("opm\n")
opt2<-optimr(x, trig.f, trig.g, method="BFGS")
opt2
opt2r<-optimr(x, trig.f, trig.g, method="Rvmmin")
opt2r
cat("====================")
x<-rep(2,4)
cat("optim(BFGS) vs Rvmmin\n")
opt4<-optim(x, trig.f, trig.g, method="BFGS")
opt4
opt4r<-optimr(x, trig.f, trig.g, method="Rvmmin")
opt4r
cat("====================")
x<-rep(2,8)
cat("optim(BFGS) vs Rvmmin\n")
opt8<-optim(x, trig.f, trig.g, method="BFGS")
opt8
opt8r<-optimr(x, trig.f, trig.g, method="Rvmmin")
opt8r

ttrig2<-opm(rep(2,2), trig.f, trig.g, method="ALL")
summary(ttrig2, order=value)

ttrig4<-opm(rep(2,4), trig.f, trig.g, method="ALL")
summary(ttrig2, order=value)

ttrig8<-opm(rep(2,8), trig.f, trig.g, method="ALL")
summary(ttrig2, order=value)

ttrig2b <- opm(rep(2,2), trig.f, trig.g, lower=rep(.1,2), upper=rep(pi,2), method="ALL")
summary(ttrig2b, order=value)

ttrig4b <- opm(rep(2,4), trig.f, trig.g, lower=rep(.1,4), upper=rep(pi,4), method="ALL")
summary(ttrig4b, order=value)

ttrig8b <- opm(rep(2,8), trig.f, trig.g, lower=rep(.1,8), upper=rep(pi,8), method="ALL")
summary(ttrig8b, order=value)
```

## 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.