Facebook
From qw, 5 Years ago, written in Plain Text.
This paste is a reply to kthchuj from kokietto - go back
Embed
Viewing differences between kthchuj and ww
library(cec2013)
library(DEoptim)


#WYMIAR 
### R code from vignette source 'DEoptim.Rnw'

###################################################
### code chunk number 1: opt
###################################################
options(prompt = "R> ")


###################################################
### code chunk number 2: rast
###################################################
rastrigin <- function(x) 
  10*length(x)+sum(x^2-10*cos(2*pi*x))


###################################################
### code chunk number 3: figure1-code
###################################################
library("colorspace")
library("grid")
library("lattice")
jpeg("Rastrigin1.jpg")
x <- y <- seq(-5,5,by=.1)
z <- matrix(nrow=length(x), ncol=length(y))
for(i in 1:length(x)) {
  for(j in 1:length(y)) 
    z[i,j] <- rastrigin(c(x[i],y[j]))
}
xx <- list(fontsize=list(text=15,points=10),
           par.xlab.text=list(cex=2),
           par.ylab.text=list(cex=2),
           axis.text=list(cex=2),
           par.main.text=list(cex=2),
           layout.widths=list(left.padding=.1, right.padding=.1,
             between=0),
           layout.heights=list(top.padding=.1, bottom.padding=.1,
             between=0)
           )
levelplot(z, row.values=x,column.values=y,
          col.regions=sequential_hcl(300), xlab=expression(x[1]), 
          ylab=expression(x[2]),
          par.settings=xx,
          panel=function(z,row.values,column.values,...){
            panel.levelplot(z,row.values,column.values,...);
            panel.points(0,0,pch=21,col="white",cex=2)})

dev.off()
set.seed(123) 


###################################################
### code chunk number 4: prelim
###################################################
library("DEoptim")


###################################################
### code chunk number 5: opt
###################################################
est.ras <- DEoptim(rastrigin,lower=c(-5,-5),upper=c(5,5),
                   control=list(storepopfrom=1, trace=FALSE))


###################################################
### code chunk number 6: figure2-code
###################################################
pushLayout <- function(nr, nc, name="layout") {
  pushViewport(viewport(layout=grid.layout(nr, nc,
                          just="left", widths=unit(rep(2, nc), "null")),
                        name=name))
  for (i in 1:nr) {
    for (j in 1:nc) {
      pushViewport(viewport(layout.pos.row=i, layout.pos.col=j))
      upViewport()
    }
  }
  upViewport()
}
names.vpPath <- names.viewport <- function(x) x$name

with.vpPath <- with.viewport <- function(data, expr, ...) {
  depth <- if (data$name == "ROOT") 0 else downViewport(names(data))
  result <- eval.parent(substitute(expr))
  upViewport(depth)
  invisible(result)
}

getChildren.viewport <- function(x) x$children  

## end functions for making the plots with lattice 
## specify number of cells to fill and number of rows

n <- 6
nr <- 2
nc <- ceiling(n/nr)
xy <- list(fontsize=list(text=12,points=10),
           par.xlab.text=list(cex=1.5),
           par.ylab.text=list(cex=1.5),
           axis.text=list(cex=1.5),
           par.main.text=list(cex=1.5),
           layout.widths=list(left.padding=.1, right.padding=.1,between=0),
           layout.heights=list(top.padding=.1, bottom.padding=.1,between=0))

jpeg("Rastrigin2.jpg")

grid.newpage()
downViewport(pushLayout(nr, nc))
vpt <- current.vpTree(all=FALSE)
plotat <- c(seq(10,50,by=10),1) 
## something strange with Sweave/grid interaction, gen.1 is getting 
## placed in wrong viewport; 'fixed' by permuting plotat above

for(k in 1:n) {
  i <- plotat[k]
  with(getChildren.viewport(vpt)[[k]],
       print(levelplot(z, row.values=x,column.values=y,
                       xlab=expression(x[1]), 
                       ylab=expression(x[2]), colorkey=FALSE,
                       par.settings=xy,between = list(x = .2),
                       col.regions=sequential_hcl(300),
                       main=paste("Generation",i), 
                       panel=function(z,row.values,column.values,...){
                         panel.levelplot(z,row.values,column.values,...);
                         panel.points(est.ras$member$storepop[[i]],
                                      pch=21,fill="black",col=1,cex=.5);
                         panel.points(0,0,pch=21,col="white",cex=1)}),
             newpage = FALSE))
}
dev.off() 


###################################################
### code chunk number 7: opt
###################################################
options(prompt = "R> ")


###################################################
### code chunk number 8: ban
###################################################
genrose.f <- function(x){
n <- length(x)
fval <- 1.0 + sum (100 * (x[1:(n-1)]^2 - x[2:n])^2 + (x[2:n] - 1)^2)
return(fval)
}


###################################################
### code chunk number 9: ban1
###################################################
<- 10
#NUMER FUNKCJI: 1...28
ans <- 11


lower 
DEoptim(fn=genrose.f, lower=rep(-5, n), upper=rep(5, n),
               control=list(NP=100, itermax=4000,trace=FALSE))


###################################################
### code chunk number 10: ban2
###################################################
ans1 
<- c(-10,-10)
upper <- -lower

outDEoptim <- DEoptim(fn=function(x){cec2013(I, rep(x, D))}, lower, upper, 
                      DEoptim.control(itermax = 100, storepopfrom = 1, storepopfreq = 2))

                      
summary(outDEoptim)

## plot intermediate populations
plot(outDEoptim, plot.type = "storepop")

optim(par=runif(10,-5,5), fn=genrose.f, method="BFGS",
              control=list(maxit=4000))
              


Replies to ww rss

Title Name Language When
qq qq text 5 Years ago.