1. ### R code from vignette source 'DEoptim.Rnw'
2.  
3. ###################################################
4. ### code chunk number 1: opt
5. ###################################################
6. options(prompt = "R> ")
7.  
8.  
9. ###################################################
10. ### code chunk number 2: rast
11. ###################################################
12. rastrigin <- function(x)
13.   10*length(x)+sum(x^2-10*cos(2*pi*x))
14.  
15.  
16. ###################################################
17. ### code chunk number 3: figure1-code
18. ###################################################
19. library("colorspace")
20. library("grid")
21. library("lattice")
22. jpeg("Rastrigin1.jpg")
23. x <- y <- seq(-5,5,by=.1)
24. z <- matrix(nrow=length(x), ncol=length(y))
25. for(i in 1:length(x)) {
26.   for(j in 1:length(y))
27.     z[i,j] <- rastrigin(c(x[i],y[j]))
28. }
29. xx <- list(fontsize=list(text=15,points=10),
30.            par.xlab.text=list(cex=2),
31.            par.ylab.text=list(cex=2),
32.            axis.text=list(cex=2),
33.            par.main.text=list(cex=2),
34.            layout.widths=list(left.padding=.1, right.padding=.1,
35.              between=0),
36.            layout.heights=list(top.padding=.1, bottom.padding=.1,
37.              between=0)
38.            )
39. levelplot(z, row.values=x,column.values=y,
40.           col.regions=sequential_hcl(300), xlab=expression(x[1]),
41.           ylab=expression(x[2]),
42.           par.settings=xx,
43.           panel=function(z,row.values,column.values,...){
44.             panel.levelplot(z,row.values,column.values,...);
45.             panel.points(0,0,pch=21,col="white",cex=2)})
46.  
47. dev.off()
48. set.seed(123)
49.  
50.  
51. ###################################################
52. ### code chunk number 4: prelim
53. ###################################################
54. library("DEoptim")
55.  
56.  
57. ###################################################
58. ### code chunk number 5: opt
59. ###################################################
60. est.ras <- DEoptim(rastrigin,lower=c(-5,-5),upper=c(5,5),
61.                    control=list(storepopfrom=1, trace=FALSE))
62.  
63.  
64. ###################################################
65. ### code chunk number 6: figure2-code
66. ###################################################
67. pushLayout <- function(nr, nc, name="layout") {
68.   pushViewport(viewport(layout=grid.layout(nr, nc,
69.                           just="left", widths=unit(rep(2, nc), "null")),
70.                         name=name))
71.   for (i in 1:nr) {
72.     for (j in 1:nc) {
73.       pushViewport(viewport(layout.pos.row=i, layout.pos.col=j))
74.       upViewport()
75.     }
76.   }
77.   upViewport()
78. }
79. names.vpPath <- names.viewport <- function(x) x$name
80.  
81. with.vpPath <- with.viewport <- function(data, expr, ...) {
82.   depth <- if (data$name == "ROOT") 0 else downViewport(names(data))
83.   result <- eval.parent(substitute(expr))
84.   upViewport(depth)
85.   invisible(result)
86. }
87.  
88. getChildren.viewport <- function(x) x$children  
89.  
90. ## end functions for making the plots with lattice
91. ## specify number of cells to fill and number of rows
92.  
93. n <- 6
94. nr <- 2
95. nc <- ceiling(n/nr)
96. xy <- list(fontsize=list(text=12,points=10),
97.            par.xlab.text=list(cex=1.5),
98.            par.ylab.text=list(cex=1.5),
99.            axis.text=list(cex=1.5),
100.            par.main.text=list(cex=1.5),
101.            layout.widths=list(left.padding=.1, right.padding=.1,between=0),
102.            layout.heights=list(top.padding=.1, bottom.padding=.1,between=0))
103.  
104. jpeg("Rastrigin2.jpg")
105.  
106. grid.newpage()
107. downViewport(pushLayout(nr, nc))
108. vpt <- current.vpTree(all=FALSE)
109. plotat <- c(seq(10,50,by=10),1)
110. ## something strange with Sweave/grid interaction, gen.1 is getting
111. ## placed in wrong viewport; 'fixed' by permuting plotat above
112.  
113. for(k in 1:n) {
114.   i <- plotat[k]
115.   with(getChildren.viewport(vpt)[[k]],
116.        print(levelplot(z, row.values=x,column.values=y,
117.                        xlab=expression(x[1]),
118.                        ylab=expression(x[2]), colorkey=FALSE,
119.                        par.settings=xy,between = list(x = .2),
120.                        col.regions=sequential_hcl(300),
121.                        main=paste("Generation",i),
122.                        panel=function(z,row.values,column.values,...){
123.                          panel.levelplot(z,row.values,column.values,...);
124.                          panel.points(est.ras$member$storepop[[i]],
125.                                       pch=21,fill="black",col=1,cex=.5);
126.                          panel.points(0,0,pch=21,col="white",cex=1)}),
127.              newpage = FALSE))
128. }
129. dev.off()
130.  
131.  
132. ###################################################
133. ### code chunk number 7: opt
134. ###################################################
135. options(prompt = "R> ")
136.  
137.  
138. ###################################################
139. ### code chunk number 8: ban
140. ###################################################
141. genrose.f <- function(x){
142. n <- length(x)
143. fval <- 1.0 + sum (100 * (x[1:(n-1)]^2 - x[2:n])^2 + (x[2:n] - 1)^2)
144. return(fval)
145. }
146.  
147.  
148. ###################################################
149. ### code chunk number 9: ban1
150. ###################################################
151. n <- 10
152. ans <- DEoptim(fn=genrose.f, lower=rep(-5, n), upper=rep(5, n),
153.                control=list(NP=100, itermax=4000,trace=FALSE))
154.  
155.  
156. ###################################################
157. ### code chunk number 10: ban2
158. ###################################################
159. ans1 <- optim(par=runif(10,-5,5), fn=genrose.f, method="BFGS",
160.               control=list(maxit=4000))
161.              
162.  
163.  
164.