├── .gitattributes ├── .gitignore ├── Chapter2 ├── functions.R ├── session-01.R ├── session-02.R ├── session-03.R ├── session-04.R ├── session-05.R ├── session-06.R ├── session-07.R ├── session-08.R ├── session-09.R ├── session-10.R ├── session-11.R ├── session-12.R ├── session-13.R ├── session-14.R └── sumbits.R ├── Chapter3 ├── bag-blind.R ├── bag-grid.R ├── binary-blind.R ├── blind.R ├── functions.R ├── grid.R ├── montecarlo.R ├── real-grid.R ├── session-binint.R └── test-mc.R ├── Chapter4 ├── bag-tabu.R ├── binary-tabu.R ├── blind.R ├── bs-hill.R ├── bs-sann.R ├── compare.R ├── functions.R ├── hill.R ├── montecarlo.R ├── sumbits-hill.R └── sumbits-sann.R ├── Chapter5 ├── bag-genalg.R ├── bag-prices-constr.R ├── compare2.R ├── eda-types.R ├── functions.R ├── gp-rastrigin.R ├── sphere-DEoptim.R ├── sphere-EDA.R ├── sphere-genalg.R └── sphere-psoptim.R ├── Chapter6 ├── lg-ga.R ├── lg-test.R ├── mo-tasks.R ├── nsga2-test.R ├── tsf.R ├── tsp.R └── wf-test.R └── Chapter7 ├── oea.R ├── tsf.R ├── tsp.R ├── tsp2.R └── wine-quality.R /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Windows image file caches 2 | Thumbs.db 3 | ehthumbs.db 4 | 5 | # Folder config file 6 | Desktop.ini 7 | 8 | # Recycle Bin used on file shares 9 | $RECYCLE.BIN/ 10 | 11 | # Windows Installer files 12 | *.cab 13 | *.msi 14 | *.msm 15 | *.msp 16 | 17 | # Windows shortcuts 18 | *.lnk 19 | 20 | # ========================= 21 | # Operating System Files 22 | # ========================= 23 | 24 | # OSX 25 | # ========================= 26 | 27 | .DS_Store 28 | .AppleDouble 29 | .LSOverride 30 | 31 | # Thumbnails 32 | ._* 33 | 34 | # Files that might appear on external disk 35 | .Spotlight-V100 36 | .Trashes 37 | 38 | # Directories potentially created on remote AFP share 39 | .AppleDB 40 | .AppleDesktop 41 | Network Trash Folder 42 | Temporary Items 43 | .apdisk 44 | -------------------------------------------------------------------------------- /Chapter2/functions.R: -------------------------------------------------------------------------------- 1 | ### functions.R file ### 2 | # compute the bag factory profit for x: 3 | # x - a vector of prices 4 | profit=function(x) # x - a vector of prices 5 | { x=round(x,digits=0) # convert x into integer 6 | s=sales(x) # get the expected sales 7 | c=cost(s) # get the expected cost 8 | profit=sum(s*x-c) # compute the profit 9 | return(profit) 10 | # local variables x, s, c and profit are lost from here 11 | } 12 | 13 | # compute the cost for producing units: 14 | # units - number of units produced 15 | # A - fixed cost, cpu - cost per unit 16 | cost=function(units,A=100,cpu=35-5*(1:length(units))) 17 | { return(A+cpu*units) } 18 | 19 | # compute the estimated sales for x: 20 | # x - a vector of prices, m - marketing effort 21 | # A, B, C - constants of the estimated function 22 | sales=function(x,A=1000,B=200,C=141, 23 | m=seq(2,length.out=length(x),by=-0.25)) 24 | { return(round(m*(A/log(x+B)-C),digits=0))} 25 | 26 | # example of a simple recursive function: 27 | fact=function(x=0) # x - integer number 28 | { if(x==0) return(1) else return(x*fact(x-1))} 29 | -------------------------------------------------------------------------------- /Chapter2/session-01.R: -------------------------------------------------------------------------------- 1 | install.packages("pso") 2 | library(pso) 3 | ?pso 4 | -------------------------------------------------------------------------------- /Chapter2/session-02.R: -------------------------------------------------------------------------------- 1 | s="hello world" 2 | print(class(s)) # character 3 | print(s) # "hello world" 4 | x=1.1 5 | print(class(x)) # numeric 6 | print(summary(x)) # summary of x 7 | plot(x) 8 | print(x) # 1.1 9 | print(pi) # 3.141593 10 | print(sqrt(-1)) # NaN 11 | print(1/0) # Inf 12 | -------------------------------------------------------------------------------- /Chapter2/session-03.R: -------------------------------------------------------------------------------- 1 | f=factor(c("a","a","b","b","c")); print(f) # create factor 2 | f[1]="c"; print(f) # change factor 3 | print(levels(f)) # show domain levels: "a" "b" "c" 4 | print(summary(f)) # show a summary of y 5 | # pdf("f-barplot.pdf") 6 | plot(f) # show y barplot 7 | #dev.off() 8 | x=c(1.1,2.3,-1,4,2e-2) # creates vector x 9 | summary(x) # show summary of x 10 | print(x) # show x 11 | str(x) # show x structure 12 | length(x) # show the length of x 13 | x[2] # show second element of x 14 | x[2:3]=(2:3)*1.1 # change 2nd and 3rd elements 15 | x[length(x)]=5 # change last element to 5 16 | print(x) # show x 17 | print(x>3) # show which x elements > 3 18 | print(which(x>3)) # show indexes of x>3 condition 19 | names(x)=c("1st","2nd","3rd","4th","5th") # change names of x 20 | print(x) # show x 21 | print(mean(x)) # show the average of x 22 | print(summary(x)) # show a summary of x 23 | y=vector(length=5); print(y) # FALSE, FALSE, ..., FALSE 24 | y[]=1; print(y) # all elements set to 1 25 | y[c(1,3,5)]=2; print(y) # 2,1,2,1,2 26 | # fancier plot of y: 27 | plot(y,type="b",lwd=3,col="gray",pch=19,panel.first=grid(5,5)) 28 | -------------------------------------------------------------------------------- /Chapter2/session-04.R: -------------------------------------------------------------------------------- 1 | x=sample(1:10,5,replace=TRUE) # 5 random samples from 1 to 10 with replacement 2 | print(x) # show x 3 | print(min(x)) # show min of x 4 | print(which.min(x)) # show index of x that contains min 5 | print(sort(x,decreasing=TRUE)) # show x in decreasing order 6 | y=seq(0,20,by=2); print(y) # y = 0, 2, ..., 20 7 | print(y[x]) # show y[x] 8 | print(y[-x]) # - means indexes of y without x values 9 | x=runif(5,0.0,10.0);print(x) # 5 uniform samples from 0 to 10 10 | y=rnorm(5,10.0,1.0);print(y) # 5 normal samples with mean 10 and std 1.0 11 | t.test(x,y) # t-student paired test 12 | -------------------------------------------------------------------------------- /Chapter2/session-05.R: -------------------------------------------------------------------------------- 1 | m=matrix(ncol=3,nrow=2); m[,]=0; print(m) # 3x2 matrix 2 | m[1,]=1:3; print(m) # change 1st row 3 | m[,3]=1:2; print(m) # change 3rd column 4 | m[2,1]=3; print(m) # change m[2,1] 5 | print(nrow(m)) # number of rows 6 | print(ncol(m)) # number of columns 7 | m[nrow(m),ncol(m)]=5; print(m) # change last element 8 | m[nrow(m)-1,ncol(m)-1]=4; print(m) # change m[1,2] 9 | print(max(m)) # show maximum of m 10 | m=sqrt(m); print(m) # change m 11 | m[1,]=c(1,1,2013); m[2,]=c(2,2,2013) # change m 12 | d=data.frame(m) # create data.frame 13 | names(d)=c("day","month","year") # change names 14 | d[1,]=c(2,1,2013); print(d) # change 1st row 15 | d$day[2]=3; print(d) # change d[1,2] 16 | d=rbind(d,c(4,3,2014)); print(d) # add row to d 17 | # change 2nd column of d to factor, same as d[,2]=factor(... 18 | d$month=factor(c("Jan","Feb","Mar")) 19 | print(summary(d)) # summary of d 20 | -------------------------------------------------------------------------------- /Chapter2/session-06.R: -------------------------------------------------------------------------------- 1 | l=list(a="hello",b=1:3) # list with 2 components 2 | print(summary(l)) # summary of l 3 | print(l) # show l 4 | l$b=l$b^2+1;print(l) # change b to (b*b)+1 5 | v=vector("list",3) # vector list 6 | v[[1]]=1:3 # change 1st element of v 7 | v[[2]]=2 # change 2nd element of v 8 | v[[3]]=l # change 3rd element of v 9 | print(v) # show v 10 | print(length(v)) # length of v 11 | -------------------------------------------------------------------------------- /Chapter2/session-07.R: -------------------------------------------------------------------------------- 1 | # two if else examples: 2 | x=0; if(x>0) cat("positive\n") else if(x==0) cat("neutral\n") else cat("negative\n") 3 | ifelse(xor(x,1),cat("TRUE\n"),cat("FALSE\n")) 4 | print(switch(3,"a","b","c")) # numeric switch example 5 | x=1; while(x<3) { print(x); x=x+1;} # while example 6 | for(i in 1:3) print(2*i) # for example #1 7 | for(i in c("a","b","c")) print(i) # for example #2 8 | for(i in 1:10) if(i%%3==0) print(i) # for example #3 9 | # character switch example: 10 | var="sin";x=1:3;y=switch(var,cos=cos(x),sin=sin(x)) 11 | cat("the",var,"of",x,"is",round(y,digits=3),"\n") 12 | -------------------------------------------------------------------------------- /Chapter2/session-08.R: -------------------------------------------------------------------------------- 1 | x=1:10;print(x) 2 | print(x>=3&x<8) # select some elements 3 | I=which(x>=3&x<8);print(I) # indexes of selection 4 | d=data.frame(x=1:4,f=factor(c(rep("a",2),rep("b",2)))) 5 | print(d) 6 | print(d[d$x<2|d$f=="b",]) # select rows 7 | -------------------------------------------------------------------------------- /Chapter2/session-09.R: -------------------------------------------------------------------------------- 1 | source("functions.R") # load the code 2 | cat("class of profit is:",class(profit),"\n") # function 3 | x=c(414.1,404.2,408.3,413.2,395.0) 4 | y=profit(x); cat("maximum profit:",y,"\n") 5 | cat("x is not changed:",x,"\n") 6 | cat("cost(x=",x,")=",cost(x),"\n") 7 | cat("sales(x=",x,")=",sales(round(x)),"\n") 8 | x=c(414,404); # sales for 2 bags: 9 | cat("sales(x=",x,")=",sales(x),"\n") 10 | cat("sales(x,A=1000,m=c(2,1.75))=",sales(x,1000,m=c(2,1.75)),"\n") 11 | # show 3! : 12 | x=3; cat("fact(",x,")=",fact(x),"\n") 13 | -------------------------------------------------------------------------------- /Chapter2/session-10.R: -------------------------------------------------------------------------------- 1 | source("functions.R") # load the code 2 | x=1:5 # show the factorial of 1:5 3 | cat(sapply(x,fact),"\n") 4 | m=matrix(ncol=5,nrow=2) 5 | m[1,]=c(1,1,1,1,1) # very cheap bags 6 | m[2,]=c(414,404,408,413,395) # optimum 7 | # show profit for both price setups: 8 | y=apply(m,1,profit); print(y) 9 | -------------------------------------------------------------------------------- /Chapter2/session-11.R: -------------------------------------------------------------------------------- 1 | x=list(a=1:3,b="hello!") # x is a list 2 | save(x,file="x.Rdata",ascii=TRUE) # save into working directory 3 | rm(x) # remove an object 4 | print(x) # gives an error 5 | load("x.Rdata") # x now exists! 6 | print(x) # show x 7 | t=readLines("x.Rdata") # read all text file 8 | cat("first line:",t[1],"\n") # show 1st line 9 | cat("first line:",readLines("x.Rdata",n=1),"\n") 10 | # write a text file using writeLines: 11 | conn=file("demo.txt") # create a connection 12 | writeLines("hello!", conn) # write something 13 | close(conn) # close connection 14 | # write a text file using sink: 15 | sink("demo2.txt") # divert output 16 | cat("hello!\n") # write something 17 | sink() # stop sink 18 | -------------------------------------------------------------------------------- /Chapter2/session-12.R: -------------------------------------------------------------------------------- 1 | # create and write a simple data.frame: 2 | d=data.frame(day=1:2,mon=factor(c("Jan","Feb")),year=c(12,13)) 3 | print(d) 4 | write.table(d,file="demo.csv",row.names=FALSE,sep=";") 5 | # read the created data.frame: 6 | d2=read.table("demo.csv",header=TRUE,sep=";") 7 | print(d2) 8 | # read white wine quality dataset from UCI repository: 9 | library(RCurl) 10 | URL="http://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-white.csv" 11 | wine=getURL(URL) 12 | write(wine,file="winequality-white.csv") # write to working directory 13 | w=read.table("winequality-white.csv",header=TRUE,sep=";") # read file 14 | cat("wine data (",nrow(w),"x",ncol(w),")\n") # show nrow x ncol 15 | -------------------------------------------------------------------------------- /Chapter2/session-13.R: -------------------------------------------------------------------------------- 1 | # create PDF file: 2 | DIR="" # change if different directory is used 3 | pdf(paste(DIR,"sumbits.pdf",sep=""),width=5,height=5) 4 | 5 | sumbinint=function(x) # sum of bits of an integer 6 | { return(sum(as.numeric(intToBits(x))))} 7 | 8 | sumbits=function(x) # sum of bits of a vector 9 | { return(sapply(x,sumbinint))} 10 | 11 | D=8; x=0:(2^D-1) # x is the search space (integer representation) 12 | y=sumbits(x) # y is the number of binary bits of x 13 | plot(x,y,type="l",ylab="evaluation function", 14 | xlab="search space (x)",lwd=2) 15 | pmax=c(x[which.max(y)],max(y)) # maximum point coordinates 16 | points(pmax[1],pmax[2],pch=19,lwd=2) # plot maximum point 17 | legend("topleft","optimum",pch=19,lwd=2) # add a legend 18 | dev.off() # close the device 19 | -------------------------------------------------------------------------------- /Chapter2/session-14.R: -------------------------------------------------------------------------------- 1 | library(multicore) # load the package 2 | x1=1:5;x2=5:10 # create 2 objects 3 | p1=parallel(factorial(x1)) # run in parallel 4 | p2=parallel(factorial(x2)) # run in parallel 5 | collect(list(p1,p2)) # collect results 6 | -------------------------------------------------------------------------------- /Chapter2/sumbits.R: -------------------------------------------------------------------------------- 1 | # create PDF file: 2 | DIR="" # change if different directory is used 3 | pdf(paste(DIR,"sumbits.pdf",sep=""),width=5,height=5) 4 | 5 | sumbinint=function(x) # sum of bits of an integer 6 | { return(sum(as.numeric(intToBits(x))))} 7 | 8 | sumbits=function(x) # sum of bits of a vector 9 | { return(sapply(x,sumbinint))} 10 | 11 | D=8; x=0:(2^D-1) # x is the search space (integer representation) 12 | y=sumbits(x) # y is the number of binary bits of x 13 | plot(x,y,type="l",ylab="evaluation function", 14 | xlab="search space (x)",lwd=2) 15 | pmax=c(x[which.max(y)],max(y)) # maximum point coordinates 16 | points(pmax[1],pmax[2],pch=19,lwd=2) # plot maximum point 17 | legend("topleft","optimum",pch=19,lwd=2) # add a legend 18 | dev.off() # close the device 19 | -------------------------------------------------------------------------------- /Chapter3/bag-blind.R: -------------------------------------------------------------------------------- 1 | ### bag-blind.R file ### 2 | 3 | source("blind.R") # load the blind search methods 4 | source("functions.R") # load profit(), cost() and sales() 5 | 6 | # auxiliary function that sets the optimum price for 7 | # one bag type (D), assuming an independent influence of 8 | # a particular price on the remaining bag prices: 9 | ibag=function(D) # D - type of bag 10 | { x=1:1000 # price for each bag type 11 | # set search space for one bag: 12 | search=matrix(ncol=5,nrow=1000) 13 | search[]=1; search[,D]=x 14 | S1=fsearch(search,profit,"max") 15 | S1$sol[D] # best price 16 | } 17 | 18 | # compute the best price for all bag types: 19 | S=sapply(1:5,ibag) 20 | # show the optimum solution: 21 | cat("optimum s:",S,"f:",profit(S),"\n") 22 | -------------------------------------------------------------------------------- /Chapter3/bag-grid.R: -------------------------------------------------------------------------------- 1 | ### bag-grid.R file ### 2 | 3 | source("blind.R") # load the blind search methods 4 | source("grid.R") # load the grid search methods 5 | source("functions.R") # load the profit function 6 | 7 | # grid search for all bag prices, step of 100$ 8 | PTM=proc.time() # start clock 9 | S1=gsearch(rep(100,5),rep(1,5),rep(1000,5),profit,"max") 10 | sec=(proc.time()-PTM)[3] # get seconds elapsed 11 | cat("gsearch best s:",S1$sol,"f:",S1$eval,"time:",sec,"s\n") 12 | 13 | # grid search 2 for all bag prices, step of 100$ 14 | PTM=proc.time() # start clock 15 | S2=gsearch2(rep(100,5),rep(1,5),rep(1000,5),profit,"max") 16 | sec=(proc.time()-PTM)[3] # get seconds elapsed 17 | cat("gsearch2 best s:",S2$sol,"f:",S2$eval,"time:",sec,"s\n") 18 | 19 | # nested grid with 3 levels and initial step of 500$ 20 | PTM=proc.time() # start clock 21 | S3=ngsearch(3,rep(500,5),rep(1,5),rep(1000,5),profit,"max") 22 | sec=(proc.time()-PTM)[3] # get seconds elapsed 23 | cat("ngsearch best s:",S3$sol,"f:",S3$eval,"time:",sec,"s\n") 24 | -------------------------------------------------------------------------------- /Chapter3/binary-blind.R: -------------------------------------------------------------------------------- 1 | ### binary-blind.R file ### 2 | 3 | source("blind.R") # load the blind search methods 4 | 5 | # read D bits from integer x: 6 | binint=function(x,D) 7 | { x=rev(intToBits(x)[1:D]) # get D bits 8 | # remove extra 0s from raw type: 9 | as.numeric(unlist(strsplit(as.character(x),""))[(1:D)*2]) 10 | } 11 | 12 | # convert binary vector into integer: code inspired in 13 | # http://stackoverflow.com/questions/12892348/ 14 | # in-r-how-to-convert-binary-string-to-binary-or-decimal-value 15 | intbin=function(x) sum(2^(which(rev(x==1))-1)) 16 | 17 | # sum a raw binary object x (evaluation function): 18 | sumbin=function(x) sum(as.numeric(x)) 19 | 20 | # max sin of binary raw object x (evaluation function): 21 | maxsin=function(x,Dim) sin(pi*(intbin(x))/(2^Dim)) 22 | 23 | D=8 # number of dimensions 24 | x=0:(2^D-1) # integer search space 25 | # set full search space in solutions x D: 26 | search=t(sapply(x,binint,D=D)) 27 | # set the domain values (D binary variables): 28 | domain=vector("list",D) 29 | for(i in 1:D) domain[[i]]=c(0,1) # bits 30 | 31 | # sum of bits, fsearch: 32 | S1=fsearch(search,sumbin,"max") # full search 33 | cat("fsearch best s:",S1$sol,"f:",S1$eval,"\n") 34 | 35 | # sum of bits, dfsearch: 36 | S2=dfsearch(domain=domain,FUN=sumbin,type="max") 37 | cat("dfsearch best s:",S2$sol,"f:",S2$eval,"\n") 38 | 39 | # max sin, fsearch: 40 | S3=fsearch(search,maxsin,"max",Dim=8) # full search 41 | cat("fsearch best s:",S3$sol,"f:",S3$eval,"\n") 42 | 43 | # max sin, dfsearch: 44 | S4=dfsearch(domain=domain,FUN=maxsin,type="max",Dim=8) 45 | cat("dfsearch best s:",S4$sol,"f:",S4$eval,"\n") 46 | -------------------------------------------------------------------------------- /Chapter3/blind.R: -------------------------------------------------------------------------------- 1 | ### blind.R file ### 2 | 3 | # full bind search method 4 | # search - matrix with solutions x D 5 | # FUN - evaluation function 6 | # type - "min" or "max" 7 | # ... - extra parameters for FUN 8 | fsearch=function(search,FUN,type="min",...) 9 | { 10 | x=apply(search,1,FUN,...) # run FUN over all search rows 11 | ib=switch(type,min=which.min(x),max=which.max(x)) 12 | return(list(index=ib,sol=search[ib,],eval=x[ib])) 13 | } 14 | 15 | # depth-first full search method 16 | # l - level of the tree 17 | # b - branch of the tree 18 | # domain - vector list of size D with domain values 19 | # FUN - eval function 20 | # type - "min" or "max" 21 | # D - dimension (number of variables) 22 | # x - current solution vector 23 | # bcur - current best sol 24 | # ... - extra parameters for FUN 25 | dfsearch=function(l=1,b=1,domain,FUN,type="min",D=length(domain), 26 | x=rep(NA,D), 27 | bcur=switch(type,min=list(sol=NULL,eval=Inf), 28 | max=list(sol=NULL,eval=-Inf)), 29 | ...) 30 | { if((l-1)==D) # "leave" with solution x to be tested: 31 | { f=FUN(x,...);fb=bcur$eval 32 | ib=switch(type,min=which.min(c(fb,f)), 33 | max=which.max(c(fb,f))) 34 | if(ib==1) return (bcur) else return(list(sol=x,eval=f)) 35 | } 36 | else # go through sub branches 37 | { for(j in 1:length(domain[[l]])) 38 | { x[l]=domain[[l]][j] 39 | bcur=dfsearch(l+1,j,domain,FUN,type,D=D, 40 | x=x,bcur=bcur,...) 41 | } 42 | return(bcur) 43 | } 44 | } 45 | -------------------------------------------------------------------------------- /Chapter3/functions.R: -------------------------------------------------------------------------------- 1 | ### functions.R file ### 2 | # compute the bag factory profit for x: 3 | # x - a vector of prices 4 | profit=function(x) # x - a vector of prices 5 | { x=round(x,digits=0) # convert x into integer 6 | s=sales(x) # get the expected sales 7 | c=cost(s) # get the expected cost 8 | profit=sum(s*x-c) # compute the profit 9 | return(profit) 10 | # local variables x, s, c and profit are lost from here 11 | } 12 | 13 | # compute the cost for producing units: 14 | # units - number of units produced 15 | # A - fixed cost, cpu - cost per unit 16 | cost=function(units,A=100,cpu=35-5*(1:length(units))) 17 | { return(A+cpu*units) } 18 | 19 | # compute the estimated sales for x: 20 | # x - a vector of prices, m - marketing effort 21 | # A, B, C - constants of the estimated function 22 | sales=function(x,A=1000,B=200,C=141, 23 | m=seq(2,length.out=length(x),by=-0.25)) 24 | { return(round(m*(A/log(x+B)-C),digits=0))} 25 | 26 | # example of a simple recursive function: 27 | fact=function(x=0) # x - integer number 28 | { if(x==0) return(1) else return(x*fact(x-1))} 29 | -------------------------------------------------------------------------------- /Chapter3/grid.R: -------------------------------------------------------------------------------- 1 | ### grid.R file ### 2 | 3 | # standard grid search method (uses fsearch) 4 | # step - vector with step size for each dimension D 5 | # lower - vector with lowest values for each dimension 6 | # upper - vector with highest values for each dimension 7 | # FUN - evaluation function 8 | # type - "min" or "max" 9 | # ... - extra parameters for FUN 10 | gsearch=function(step,lower,upper,FUN,type="min",...) 11 | { D=length(step) # dimension 12 | domain=vector("list",D) # domain values 13 | L=vector(length=D) # auxiliary vector 14 | for(i in 1:D) 15 | { domain[[i]]=seq(lower[i],upper[i],by=step[i]) 16 | L[i]=length(domain[[i]]) 17 | } 18 | LS=prod(L) 19 | s=matrix(ncol=D,nrow=LS) # set the search space 20 | for(i in 1:D) 21 | { 22 | if(i==1) E=1 else E=E*L[i-1] 23 | s[,i]=rep(domain[[i]],length.out=LS,each=E) 24 | } 25 | fsearch(s,FUN,type,...) # best solution 26 | } 27 | 28 | # standard grid search method (uses dfsearch) 29 | gsearch2=function(step,lower,upper,FUN,type="min",...) 30 | { D=length(step) # dimension 31 | domain=vector("list",D) # domain values 32 | for(i in 1:D) domain[[i]]=seq(lower[i],upper[i],by=step[i]) 33 | dfsearch(domain=domain,FUN=FUN,type=type,...) # solution 34 | } 35 | 36 | # nested grid search method (uses fsearch) 37 | # levels - number of nested levels 38 | ngsearch=function(levels,step,lower,upper,FUN,type,...) 39 | { stop=FALSE;i=1 # auxiliary objects 40 | bcur=switch(type,min=list(sol=NULL,eval=Inf), 41 | max=list(sol=NULL,eval=-Inf)) 42 | while(!stop) # cycle while stopping criteria is not met 43 | { 44 | s=gsearch(step,lower,upper,FUN,type,...) 45 | # if needed, update best current solution: 46 | if( (type=="min" && s$evalbcur$eval)) bcur=s 48 | if(i=levels || sum((upper-lower)<=step)>0) stop=TRUE 55 | else i=i+1 56 | } 57 | return(bcur) # best solution 58 | } 59 | -------------------------------------------------------------------------------- /Chapter3/montecarlo.R: -------------------------------------------------------------------------------- 1 | ### montecarlo.R file ### 2 | 3 | # montecarlo uniform search method 4 | # N - number of samples 5 | # lower - vector with lowest values for each dimension 6 | # upper - vector with highest values for each dimension 7 | # domain - vector list of size D with domain values 8 | # FUN - evaluation function 9 | # type - "min" or "max" 10 | # ... - extra parameters for FUN 11 | mcsearch=function(N,lower,upper,FUN,type="min",...) 12 | { D=length(lower) 13 | s=matrix(nrow=N,ncol=D) # set the search space 14 | for(i in 1:N) s[i,]=runif(D,lower,upper) 15 | fsearch(s,FUN,type,...) # best solution 16 | } 17 | -------------------------------------------------------------------------------- /Chapter3/real-grid.R: -------------------------------------------------------------------------------- 1 | ### real-grid.R file ### 2 | 3 | source("blind.R") # load the blind search methods 4 | source("grid.R") # load the grid search methods 5 | 6 | # real-value functions: sphere and rastrigin: 7 | sphere=function(x) sum(x^2) 8 | rastrigin=function(x) 10*length(x)+sum(x^2-10*cos(2*pi*x)) 9 | 10 | cat("sphere:\n") # D=2, easy task 11 | S=gsearch(rep(1.1,2),rep(-5.2,2),rep(5.2,2),sphere,"min") 12 | cat("gsearch s:",S$sol,"f:",S$eval,"\n") 13 | S=ngsearch(3,rep(3,2),rep(-5.2,2),rep(5.2,2),sphere,"min") 14 | cat("ngsearch s:",S$sol,"f:",S$eval,"\n") 15 | 16 | cat("rastrigin:\n") # D=2, easy task 17 | S=gsearch(rep(1.1,2),rep(-5.2,2),rep(5.2,2),rastrigin,"min") 18 | cat("gsearch s:",S$sol,"f:",S$eval,"\n") 19 | S=ngsearch(3,rep(3,2),rep(-5.2,2),rep(5.2,2),rastrigin,"min") 20 | cat("ngsearch s:",S$sol,"f:",S$eval,"\n") 21 | -------------------------------------------------------------------------------- /Chapter3/session-binint.R: -------------------------------------------------------------------------------- 1 | x=intToBits(7)[1:4]; print(x) 2 | x=rev(x); print(x) 3 | x=strsplit(as.character(x),""); print(x) 4 | x=unlist(x); print(x) 5 | x=as.numeric(x[(1:4)*2]); print(x) 6 | -------------------------------------------------------------------------------- /Chapter3/test-mc.R: -------------------------------------------------------------------------------- 1 | ### test-mc.R file ### 2 | 3 | source("blind.R") # load the blind search methods 4 | source("montecarlo.R") # load the monte carlo method 5 | source("functions.R") # load the profit function 6 | 7 | N=10000 # set the number of samples 8 | cat("monte carlo search (N:",N,")\n") 9 | 10 | # bag prices 11 | cat("bag prices:") 12 | S=mcsearch(N,rep(1,5),rep(1000,5),profit,"max") 13 | cat("s:",S$sol,"f:",S$eval,"\n") 14 | 15 | # real-value functions: sphere and rastrigin: 16 | sphere=function(x) sum(x^2) 17 | rastrigin=function(x) 10*length(x)+sum(x^2-10*cos(2*pi*x)) 18 | 19 | D=c(2,30) 20 | label="sphere" 21 | for(i in 1:length(D)) 22 | { S=mcsearch(N,rep(-5.2,D[i]),rep(5.2,D[i]),sphere,"min") 23 | cat(label,"D:",D[i],"s:",S$sol[1:2],"f:",S$eval,"\n") 24 | } 25 | label="rastrigin" 26 | for(i in 1:length(D)) 27 | { S=mcsearch(N,rep(-5.2,D[i]),rep(5.2,D[i]),rastrigin,"min") 28 | cat(label,"D:",D[i],"s:",S$sol[1:2],"f:",S$eval,"\n") 29 | } 30 | -------------------------------------------------------------------------------- /Chapter4/bag-tabu.R: -------------------------------------------------------------------------------- 1 | ### bag-tabu.R file ### 2 | library(tabuSearch) # load tabuSearch package 3 | source("functions.R") # load the profit function 4 | 5 | # tabu search for bag prices: 6 | D=5 # dimension (number of prices) 7 | MaxPrice=1000 8 | Dim=ceiling(log(MaxPrice,2)) # size of each price (=10) 9 | size=D*Dim # total number of bits (=50) 10 | s=sample(0:1,size,replace=TRUE) # initial search 11 | 12 | intbin=function(x) # convert binary to integer 13 | { sum(2^(which(rev(x==1))-1)) } # explained in Chapter 3 14 | bintbin=function(x) # convert binary to D prices 15 | { # note: D and Dim need to be set outside this function 16 | s=vector(length=D) 17 | for(i in 1:D) # convert x into s: 18 | { ini=(i-1)*Dim+1;end=ini+Dim-1 19 | s[i]=intbin(x[ini:end]) 20 | } 21 | return(s) 22 | } 23 | bprofit=function(x) # profit for binary x 24 | { s=bintbin(x) 25 | if(sum(s>MaxPrice)>0) f=-Inf # death penalty 26 | else f=profit(s) 27 | return(f) 28 | } 29 | 30 | cat("initial:",bintbin(s),"f:",bprofit(s),"\n") 31 | s=tabuSearch(size,iters=100,objFunc=bprofit,config=s,neigh=4,listSize=16,nRestarts=1) 32 | b=which.max(s$eUtilityKeep) # best index 33 | cat("best:",bintbin(s$configKeep[b,]),"f:",s$eUtilityKeep[b],"\n") 34 | 35 | -------------------------------------------------------------------------------- /Chapter4/binary-tabu.R: -------------------------------------------------------------------------------- 1 | ### binary-tabu.R file ### 2 | library(tabuSearch) # load tabuSearch package 3 | 4 | # tabu search for sum of bits: 5 | sumbin=function(x) (sum(x)) # sum of bits 6 | D=8 # dimension 7 | s=rep(0,D) # c(0,0,0,0,...) 8 | s=tabuSearch(D,iters=2,objFunc=sumbin,config=s,neigh=2, 9 | listSize=4,nRestarts=1) 10 | b=which.max(s$eUtilityKeep) # best index 11 | cat("best:",s$configKeep[b,],"f:",s$eUtilityKeep[b],"\n") 12 | 13 | # tabu search for max sin: 14 | intbin=function(x) sum(2^(which(rev(x==1))-1)) 15 | maxsin=function(x) # max sin (explained in Chapter 3) 16 | { D=length(x);x=intbin(x); return(sin(pi*(as.numeric(x))/(2^D))) } 17 | D=8 18 | s=rep(0,D) # c(0,0,0,0,...) 19 | s=tabuSearch(D,iters=2,objFunc=maxsin,config=s,neigh=2, 20 | listSize=4,nRestarts=1) 21 | b=which.max(s$eUtilityKeep) # best index 22 | cat("best:",s$configKeep[b,],"f:",s$eUtilityKeep[b],"\n") 23 | -------------------------------------------------------------------------------- /Chapter4/blind.R: -------------------------------------------------------------------------------- 1 | ### blind.R file ### 2 | 3 | # full bind search method 4 | # search - matrix with solutions x D 5 | # FUN - evaluation function 6 | # type - "min" or "max" 7 | # ... - extra parameters for FUN 8 | fsearch=function(search,FUN,type="min",...) 9 | { 10 | x=apply(search,1,FUN,...) # run FUN over all search rows 11 | ib=switch(type,min=which.min(x),max=which.max(x)) 12 | return(list(index=ib,sol=search[ib,],eval=x[ib])) 13 | } 14 | 15 | # depth-first full search method 16 | # l - level of the tree 17 | # b - branch of the tree 18 | # domain - vector list of size D with domain values 19 | # FUN - eval function 20 | # type - "min" or "max" 21 | # D - dimension (number of variables) 22 | # x - current solution vector 23 | # bcur - current best sol 24 | # ... - extra parameters for FUN 25 | dfsearch=function(l=1,b=1,domain,FUN,type="min",D=length(domain), 26 | x=rep(NA,D), 27 | bcur=switch(type,min=list(sol=NULL,eval=Inf), 28 | max=list(sol=NULL,eval=-Inf)), 29 | ...) 30 | { if((l-1)==D) # "leave" with solution x to be tested: 31 | { f=FUN(x,...);fb=bcur$eval 32 | ib=switch(type,min=which.min(c(fb,f)), 33 | max=which.max(c(fb,f))) 34 | if(ib==1) return (bcur) else return(list(sol=x,eval=f)) 35 | } 36 | else # go through sub branches 37 | { for(j in 1:length(domain[[l]])) 38 | { x[l]=domain[[l]][j] 39 | bcur=dfsearch(l+1,j,domain,FUN,type,D=D, 40 | x=x,bcur=bcur,...) 41 | } 42 | return(bcur) 43 | } 44 | } 45 | -------------------------------------------------------------------------------- /Chapter4/bs-hill.R: -------------------------------------------------------------------------------- 1 | ### bs-hill.R file ### 2 | 3 | source("hill.R") # load the hill climbing methods 4 | source("functions.R") # load the profit function 5 | 6 | # hill climbing for all bag prices, one run: 7 | D=5; C=list(maxit=10000,REPORT=10000) # 10000 iterations 8 | s=sample(1:1000,D,replace=TRUE) # initial search 9 | ichange=function(par,lower,upper) # integer value change 10 | { hchange(par,lower,upper,rnorm,mean=0,sd=1) } 11 | hclimbing(s,profit,change=ichange,lower=rep(1,D), 12 | upper=rep(1000,D),control=C,type="max") 13 | 14 | # hill climbing for sphere, one run: 15 | sphere=function(x) sum(x^2) 16 | D=2; C=list(maxit=10000,REPORT=10000) 17 | rchange=function(par,lower,upper) # real value change 18 | { hchange(par,lower,upper,rnorm,mean=0,sd=0.5,round=FALSE) } 19 | 20 | s=runif(D,-5.2,5.2) # initial search 21 | hclimbing(s,sphere,change=rchange,lower=rep(-5.2,D), 22 | upper=rep(5.2,D),control=C,type="min") 23 | -------------------------------------------------------------------------------- /Chapter4/bs-sann.R: -------------------------------------------------------------------------------- 1 | ### bs-sann.R file ### 2 | 3 | source("hill.R") # load the hchange method 4 | source("functions.R") # load the profit function 5 | eval=function(x) -profit(x) # optim minimizes! 6 | 7 | # hill climbing for all bag prices, one run: 8 | D=5; C=list(maxit=10000,temp=1000,trace=TRUE,REPORT=10000) 9 | s=sample(1:1000,D,replace=TRUE) # initial search 10 | ichange=function(par) # integer value change 11 | { D=length(par) 12 | hchange(par,lower=rep(1,D),upper=rep(1000,D),rnorm,mean=0,sd=1) 13 | } 14 | s=optim(s,eval,gr=ichange,method="SANN",control=C) 15 | cat("best:",s$par,"profit:",abs(s$value),"\n") 16 | 17 | # hill climbing for sphere, one run: 18 | sphere=function(x) sum(x^2) 19 | D=2; C=list(maxit=10000,temp=1000,trace=TRUE,REPORT=10000) 20 | 21 | s=runif(D,-5.2,5.2) # initial search 22 | # SANN with default change (gr) function: 23 | s=optim(s,sphere,method="SANN",control=C) 24 | cat("best:",s$par,"f:",s$value,"\n") 25 | -------------------------------------------------------------------------------- /Chapter4/compare.R: -------------------------------------------------------------------------------- 1 | ### compare.R file ### 2 | 3 | source("hill.R") # get hchange 4 | source("blind.R") # get fsearch 5 | source("montecarlo.R") # get mcsearch 6 | library(rminer) # get meanint 7 | 8 | # comparison setup: 9 | crastrigin=function(x) 10 | { f=10*length(x)+sum(x^2-10*cos(2*pi*x)) 11 | # global assignment code: <<- 12 | EV<<-EV+1 # increase evaluations 13 | if(f0 &&(i==1||i%%control$REPORT==0)) 22 | cat("i:",i,"s:",par,"f:",fpar,"s'",par1,"f:",fpar1,"\n") 23 | if( (type=="min" && fpar1fpar)) { par=par1;fpar=fpar1 } 25 | } 26 | if(control$REPORT>=1) cat("best:",par,"f:",fpar,"\n") 27 | return(list(sol=par,eval=fpar)) 28 | } 29 | 30 | # slight random change of vector par: 31 | # par - initial solution 32 | # lower - vector with lowest values for each dimension 33 | # upper - vector with highest values for each dimension 34 | # dist - random distribution function 35 | # round - use integer (TRUE) or continuous (FALSE) search 36 | # ... - extra parameters for dist 37 | # examples: dist=rnorm, mean=0, sd=1; dist=runif, min=0,max=1 38 | hchange=function(par,lower,upper,dist,round=TRUE,...) 39 | { D=length(par) # dimension 40 | step=dist(D,...) # slight step 41 | if(round) step=round(step) 42 | par1=par+step 43 | # return par1 within [lower,upper]: 44 | return(ifelse(par1upper,upper,par1))) 45 | } 46 | -------------------------------------------------------------------------------- /Chapter4/montecarlo.R: -------------------------------------------------------------------------------- 1 | ### montecarlo.R file ### 2 | 3 | # montecarlo uniform search method 4 | # N - number of samples 5 | # lower - vector with lowest values for each dimension 6 | # upper - vector with highest values for each dimension 7 | # domain - vector list of size D with domain values 8 | # FUN - evaluation function 9 | # type - "min" or "max" 10 | # ... - extra parameters for FUN 11 | mcsearch=function(N,lower,upper,FUN,type="min",...) 12 | { D=length(lower) 13 | s=matrix(nrow=N,ncol=D) # set the search space 14 | for(i in 1:N) s[i,]=runif(D,lower,upper) 15 | fsearch(s,FUN,type,...) # best solution 16 | } 17 | -------------------------------------------------------------------------------- /Chapter4/sumbits-hill.R: -------------------------------------------------------------------------------- 1 | ### sumbits-hill.R file ### 2 | 3 | source("hill.R") # load the hill climbing methods 4 | 5 | # sum a raw binary object x (evaluation function): 6 | sumbin=function(x) sum(x) 7 | 8 | # hill climbing for sum of bits, one run: 9 | D=8 # dimension 10 | s=rep(0,D) # c(0,0,0,0,...) 11 | C=list(maxit=10,REPORT=1) # maximum of 10 iterations 12 | ichange=function(par,lower,upper) # integer change 13 | { hchange(par,lower,upper,rnorm,mean=0,sd=1) } 14 | 15 | hclimbing(s,sumbin,change=ichange,lower=rep(0,D),upper=rep(1,D), 16 | control=C,type="max") 17 | -------------------------------------------------------------------------------- /Chapter4/sumbits-sann.R: -------------------------------------------------------------------------------- 1 | ### sumbits-sann.R file ### 2 | source("hill.R") # get hchange function 3 | # sum a raw binary object x (evaluation function): 4 | minsumbin=function(x) (length(x)-sum(x)) # optim only minimizes! 5 | 6 | # SANN for sum of bits, one run: 7 | D=8 # dimension 8 | s=rep(0,D) # c(0,0,0,0,...) 9 | C=list(maxit=10,temp=10,tmax=1,trace=TRUE,REPORT=1) 10 | bchange=function(par) # binary change 11 | { D=length(par) 12 | hchange(par,lower=rep(0,D),upper=rep(1,D),rnorm,mean=0,sd=1) 13 | } 14 | s=optim(s,minsumbin,gr=bchange,method="SANN",control=C) 15 | cat("best:",s$par,"f:",s$value,"(max: fs:",sum(s$par),")\n") 16 | -------------------------------------------------------------------------------- /Chapter5/bag-genalg.R: -------------------------------------------------------------------------------- 1 | ### bag-genalg.R file ### 2 | library(genalg) # load genalg package 3 | source("functions.R") # load the profit function 4 | 5 | # genetic algorithm search for bag prices: 6 | D=5 # dimension (number of prices) 7 | MaxPrice=1000 8 | Dim=ceiling(log(MaxPrice,2)) # size of each price (=10) 9 | size=D*Dim # total number of bits (=50) 10 | intbin=function(x) # convert binary to integer 11 | { sum(2^(which(rev(x==1))-1)) } # explained in Chapter 3 12 | bintbin=function(x) # convert binary to D prices 13 | { # note: D and Dim need to be set outside this function 14 | s=vector(length=D) 15 | for(i in 1:D) # convert x into s: 16 | { ini=(i-1)*Dim+1;end=ini+Dim-1 17 | s[i]=intbin(x[ini:end]) 18 | } 19 | return(s) 20 | } 21 | bprofit=function(x) # profit for binary x 22 | { s=bintbin(x) 23 | s=ifelse(s>MaxPrice,MaxPrice,s) # repair! 24 | f=-profit(s) # minimization task! 25 | return(f) 26 | } 27 | # genetic algorithm execution: 28 | G=rbga.bin(size=size,popSize=50,iters=100,zeroToOneRatio=1,evalFunc=bprofit,elitism=1) 29 | # show results: 30 | b=which.min(G$evaluations) # best individual 31 | cat("best:",bintbin(G$population[b,]),"f:",-G$evaluations[b], 32 | "\n") 33 | pdf("genalg1.pdf") # personalized plot of G results 34 | plot(-G$best,type="l",lwd=2,ylab="profit",xlab="generations") 35 | lines(-G$mean,lty=2,lwd=2) 36 | legend("bottomright",c("best","mean"),lty=1:2,lwd=2) 37 | dev.off() 38 | summary(G,echo=TRUE) # same as summary.rbga 39 | -------------------------------------------------------------------------------- /Chapter5/bag-prices-constr.R: -------------------------------------------------------------------------------- 1 | ### bag-prices-constr.R file ### 2 | 3 | source("functions.R") # bag prices functions 4 | library(copulaedas) # EDA 5 | 6 | # evaluation function: ------------------------------------ 7 | cprofit2=function(x) # bag prices with death penalty 8 | { x=round(x,digits=0) # convert x into integer 9 | x=ifelse(x<1,1,x) # assure that x is within 10 | x=ifelse(x>1000,1000,x) # the [1,1000] bounds 11 | s=sales(x) 12 | if(sum(s)>50) res=Inf # if needed, death penalty!!! 13 | else{ c=cost(s);profit=sum(s*x-c) 14 | # if needed, store best value 15 | if(profit>BEST) { BEST<<-profit; B<<-x} 16 | res=-profit # minimization task! 17 | } 18 | EV<<-EV+1 # increase evaluations 19 | if(EV<=MAXFN) F[EV]<<-BEST 20 | return(res) 21 | } 22 | # example of a local search method that repairs a solution: 23 | localRepair=function(eda, gen, pop, popEval, f, lower, upper) 24 | { 25 | for(i in 1:nrow(pop)) 26 | { x=pop[i,] 27 | x=round(x,digits=0) # convert x into integer 28 | x=ifelse(xupper[1],upper[1],x) # bounds 30 | s=sales(x) 31 | if(sum(s)>50) 32 | { 33 | x1=x 34 | while(sum(s)>50) # new constraint: repair 35 | { # increase price to reduce sales: 36 | x1=x1+abs(round(rnorm(D,mean=0,sd=5))) 37 | x1=ifelse(x1>upper[1],upper[1],x1) # bound if needed 38 | s=sales(x1) 39 | } 40 | x=x1 # update the new x 41 | } 42 | pop[i,]=x;popEval[i]=f(x) 43 | } 44 | return(list(pop=pop,popEval=popEval)) 45 | } 46 | 47 | # experiment: ---------------------------------------------- 48 | MAXFN=5000 49 | Runs=50; D=5; LP=50; maxit=100 50 | lower=rep(1,D);upper=rep(1000,D) 51 | Methods=c("Death","Repair") 52 | setMethod("edaTerminate","EDA",edaTerminateMaxGen) 53 | GCEDA=CEDA(copula="normal",margin="norm",popSize=LP, 54 | maxGen=maxit,fEvalStdDev=10) 55 | GCEDA@name="GCEDA" 56 | 57 | RES=vector("list",length(Methods)) # all results 58 | VAL=matrix(nrow=Runs,ncol=length(Methods)) # best values 59 | for(m in 1:length(Methods)) # initialize RES object 60 | RES[[m]]=matrix(nrow=MAXFN,ncol=Runs) 61 | for(R in 1:Runs) # cycle all runs 62 | { 63 | B=NA;EV=0; F=rep(NA,MAXFN); BEST= -Inf # reset vars. 64 | setMethod("edaOptimize","EDA",edaOptimizeDisabled) 65 | setMethod("edaTerminate","EDA",edaTerminateMaxGen) 66 | suppressWarnings(edaRun(GCEDA,cprofit2,lower,upper)) 67 | RES[[1]][,R]=F # store all best values 68 | VAL[R,1]=F[MAXFN] # store best value at MAXFN 69 | 70 | B=NA;EV=0; F=rep(NA,MAXFN); BEST= -Inf # reset vars. 71 | # set local repair search method: 72 | setMethod("edaOptimize","EDA",localRepair) 73 | # set additional termination criterion: 74 | setMethod("edaTerminate","EDA", 75 | edaTerminateCombined(edaTerminateMaxGen,edaTerminateEvalStdDev)) 76 | # this edaRun might produces warnings or errors: 77 | suppressWarnings(try(edaRun(GCEDA,cprofit2,lower,upper),silent=TRUE)) 78 | if(EV1000,1000,x) # the [1,1000] bounds 23 | s=sales(x) # get the expected sales 24 | c=cost(s) # get the expected cost 25 | profit=sum(s*x-c) # compute the profit 26 | EV<<-EV+1 # increase evaluations 27 | if(profit>BEST) BEST<<-profit # maximum value 28 | if(EV<=MAXFN) F[EV]<<-BEST 29 | return(-profit) # minimization task! 30 | } 31 | # auxiliary functions: ------------------------------------ 32 | crun=function(method,f,lower,upper,LP,maxit) # run a method 33 | { if(method=="EA") 34 | rbga(evalFunc=f,stringMin=lower,stringMax=upper,popSize=LP, 35 | iters=maxit*1.5) 36 | else if(method=="DE") 37 | { C=DEoptim.control(itermax=maxit,trace=FALSE,NP=LP) 38 | DEoptim(f,lower=lower,upper=upper,control=C) 39 | } 40 | else if(method=="PSO") 41 | { C=list(maxit=maxit,s=LP) 42 | psoptim(rep(NA,length(lower)),fn=f, 43 | lower=lower,upper=upper,control=C) 44 | } 45 | else if(method=="EDA") 46 | { setMethod("edaTerminate","EDA",edaTerminateMaxGen) 47 | GCEDA=CEDA(copula="normal",margin="norm",popSize=LP, 48 | maxGen=maxit) 49 | GCEDA@name="GCEDA" 50 | edaRun(GCEDA,f,lower,upper) 51 | } 52 | } 53 | 54 | successes=function(x,LIM,type="min") # number of successes 55 | { if(type=="min") return(sum(xLIM)) } 56 | 57 | ctest=function(Methods,f,lower,upper,type="min",Runs, # test 58 | D,MAXFN,maxit,LP,pdf,main,LIM) # all methods: 59 | { RES=vector("list",length(Methods)) # all results 60 | VAL=matrix(nrow=Runs,ncol=length(Methods)) # best values 61 | for(m in 1:length(Methods)) # initialize RES object 62 | RES[[m]]=matrix(nrow=MAXFN,ncol=Runs) 63 | 64 | for(R in 1:Runs) # cycle all runs 65 | for(m in 1:length(Methods)) 66 | { EV<<-0; F<<-rep(NA,MAXFN) # reset EV and F 67 | if(type=="min") BEST<<-Inf else BEST<<- -Inf # reset BEST 68 | suppressWarnings(crun(Methods[m],f,lower,upper,LP,maxit)) 69 | RES[[m]][,R]=F # store all best values 70 | VAL[R,m]=F[MAXFN] # store best value at MAXFN 71 | } 72 | # compute average F result per method: 73 | AV=matrix(nrow=MAXFN,ncol=length(Methods)) 74 | for(m in 1:length(Methods)) 75 | for(i in 1:MAXFN) 76 | AV[i,m]=mean(RES[[m]][i,]) 77 | # show results: 78 | cat(main,"\n",Methods,"\n") 79 | cat(round(apply(VAL,2,mean),digits=0)," (average best)\n") 80 | cat(round(100*apply(VAL,2,successes,LIM,type)/Runs, 81 | digits=0)," (%successes)\n") 82 | 83 | # create pdf file: 84 | pdf(paste(pdf,".pdf",sep=""),width=5,height=5,paper="special") 85 | par(mar=c(4.0,4.0,1.8,0.6)) # reduce default plot margin 86 | MIN=min(AV);MAX=max(AV) 87 | # use a grid to improve clarity: 88 | g1=seq(1,MAXFN,length.out=500) # grid for lines 89 | plot(g1,AV[g1,1],ylim=c(MIN,MAX),type="l",lwd=2,main=main, 90 | ylab="average best",xlab="number of evaluations") 91 | for(i in 2:length(Methods)) lines(g1,AV[g1,i],lwd=2,lty=i) 92 | if(type=="min") position="topright" else position="bottomright" 93 | legend(position,legend=Methods,lwd=2,lty=1:length(Methods)) 94 | dev.off() # close the PDF device 95 | } 96 | 97 | # define EV, BEST and F: 98 | MAXFN=10000 99 | EV=0;BEST=Inf;F=rep(NA,MAXFN) 100 | # define method labels: 101 | Methods=c("EA","DE","PSO","EDA") 102 | # rastrigin comparison: ----------------------------------- 103 | Runs=50; D=20; LP=100; maxit=100 104 | lower=rep(-5.2,D);upper=rep(5.2,D) 105 | ctest(Methods,crastrigin,lower,upper,"min",Runs,D,MAXFN,maxit,LP, 106 | "comp-rastrigin2","rastrigin (D=20)",75) 107 | # bag prices comparison: ---------------------------------- 108 | MAXFN=5000 109 | F=rep(NA,MAXFN) 110 | Runs=50; D=5; LP=50; maxit=100 111 | lower=rep(1,D);upper=rep(1000,D) 112 | ctest(Methods,cprofit,lower,upper,"max",Runs,D,MAXFN,maxit,LP, 113 | "comp-bagprices","bag prices (D=5)",43500) 114 | -------------------------------------------------------------------------------- /Chapter5/eda-types.R: -------------------------------------------------------------------------------- 1 | # four EDA types: 2 | # adapted from (Gonzalez-Fernandez and Soto, 2012) 3 | UMDA=CEDA(copula="indep",margin="norm"); UMDA@name="UMDA" 4 | GCEDA=CEDA(copula="normal",margin="norm"); GCEDA@name="GCEDA" 5 | CVEDA=VEDA(vine="CVine",indepTestSigLevel=0.01, 6 | copulas = c("normal"),margin = "norm") 7 | CVEDA@name="CVEDA" 8 | DVEDA=VEDA(vine="DVine",indepTestSigLevel=0.01, 9 | copulas = c("normal"),margin = "norm") 10 | DVEDA@name="DVEDA" 11 | 12 | -------------------------------------------------------------------------------- /Chapter5/functions.R: -------------------------------------------------------------------------------- 1 | ### functions.R file ### 2 | # compute the bag factory profit for x: 3 | # x - a vector of prices 4 | profit=function(x) # x - a vector of prices 5 | { x=round(x,digits=0) # convert x into integer 6 | s=sales(x) # get the expected sales 7 | c=cost(s) # get the expected cost 8 | profit=sum(s*x-c) # compute the profit 9 | return(profit) 10 | # local variables x, s, c and profit are lost from here 11 | } 12 | 13 | # compute the cost for producing units: 14 | # units - number of units produced 15 | # A - fixed cost, cpu - cost per unit 16 | cost=function(units,A=100,cpu=35-5*(1:length(units))) 17 | { return(A+cpu*units) } 18 | 19 | # compute the estimated sales for x: 20 | # x - a vector of prices, m - marketing effort 21 | # A, B, C - constants of the estimated function 22 | sales=function(x,A=1000,B=200,C=141, 23 | m=seq(2,length.out=length(x),by=-0.25)) 24 | { return(round(m*(A/log(x+B)-C),digits=0))} 25 | 26 | # example of a simple recursive function: 27 | fact=function(x=0) # x - integer number 28 | { if(x==0) return(1) else return(x*fact(x-1))} 29 | -------------------------------------------------------------------------------- /Chapter5/gp-rastrigin.R: -------------------------------------------------------------------------------- 1 | ### gp-rastrigin.R ### 2 | 3 | library(rgp) # load rgp 4 | 5 | # auxiliary functions: 6 | rastrigin=function(x) 10*length(x)+sum(x^2-10*cos(2*pi*x)) 7 | fwrapper=function(x,f) f(x[1],x[2]) 8 | 9 | # configuration of the genetic programming: 10 | ST=inputVariableSet("x1","x2") 11 | cF1=constantFactorySet(function() rnorm(1)) # mean=0, sd=1 12 | FS=functionSet("+","*","-") 13 | # set the input samples (grid^2 data points): 14 | grid=10 # size of the grid used 15 | domain=matrix(ncol=2,nrow=grid^2) # 2D domain grid 16 | domain[,1]=rep(seq(-5.2,5.2,length.out=grid),each=grid) 17 | domain[,2]=rep(seq(-5.2,5.2,length.out=grid),times=grid) 18 | eval=function(f) # evaluation function 19 | { mse(apply(domain,1,rastrigin),apply(domain,1,fwrapper,f)) } 20 | 21 | # run the genetic programming: 22 | # Note: in the book, the rgp version 0.3-4 version was used; 23 | # other versions might produce different results 24 | set.seed(12345) # set for replicability 25 | mut=function(func) # set the mutation function 26 | { mutateSubtree(func,funcset=FS,inset=ST, conset=cF1, 27 | mutatesubtreeprob=0.1,maxsubtreedepth=4) } 28 | gp=geneticProgramming(functionSet=FS,inputVariables=ST, 29 | constantSet=cF1,populationSize=50, 30 | fitnessFunction=eval, 31 | stopCondition=makeTimeStopCondition(50), 32 | mutationFunction=mut, 33 | verbose=TRUE) 34 | # show the results: 35 | b=gp$population[[which.min(gp$fitnessValues)]] 36 | cat("best solution (f=",eval(b),"):\n") 37 | print(b) 38 | # create approximation plot: 39 | L1=apply(domain,1,rastrigin);L2=apply(domain,1,fwrapper,b) 40 | MIN=min(L1,L2);MAX=max(L1,L2) 41 | pdf("gp-function.pdf",width=7,height=7,paper="special") 42 | plot(L1,ylim=c(MIN,MAX),type="l",lwd=2,lty=1, 43 | xlab="points",ylab="function values") 44 | lines(L2,type="l",lwd=2,lty=2) 45 | legend("bottomright",leg=c("rastrigin","GP function"),lwd=2, 46 | lty=1:2) 47 | dev.off() 48 | -------------------------------------------------------------------------------- /Chapter5/sphere-DEoptim.R: -------------------------------------------------------------------------------- 1 | ### sphere-DEoptim.R file ### 2 | library(DEoptim) # load DEoptim 3 | 4 | sphere=function(x) sum(x^2) 5 | D=2 6 | maxit=100 7 | set.seed(12345) # set for replicability 8 | C=DEoptim.control(strategy=1,NP=5,itermax=maxit,CR=0.9,F=0.8, 9 | trace=25,storepopfrom=1,storepopfreq=1) 10 | # perform the optimization: 11 | D=suppressWarnings(DEoptim(sphere,rep(-5.2,D),rep(5.2,D), 12 | control=C)) 13 | # show result: 14 | summary(D) 15 | pdf("DEoptim.pdf",onefile=FALSE,width=5,height=9, 16 | colormodel="gray") 17 | plot(D,plot.type="storepop") 18 | dev.off() 19 | cat("best:",D$optim$bestmem,"f:",D$optim$bestval,"\n") 20 | -------------------------------------------------------------------------------- /Chapter5/sphere-EDA.R: -------------------------------------------------------------------------------- 1 | ### sphere-EDA.R file ### 2 | library(copulaedas) 3 | 4 | sphere=function(x) sum(x^2) 5 | 6 | D=2; maxit=10; LP=5 7 | set.seed(12345) # set for replicability 8 | 9 | # set termination criterion and report method: 10 | setMethod("edaTerminate","EDA",edaTerminateMaxGen) 11 | setMethod("edaReport","EDA",edaReportSimple) 12 | 13 | # set EDA type: 14 | UMDA=CEDA(copula="indep",margin="norm",popSize=LP,maxGen=maxit) 15 | UMDA@name="UMDA (LP=5)" 16 | # run the algorithm: 17 | E=edaRun(UMDA,sphere,rep(-5.2,D),rep(5.2,D)) 18 | # show result: 19 | show(E) 20 | cat("best:",E@bestSol,"f:",E@bestEval,"\n") 21 | 22 | # second EDA execution, using LP=100: 23 | maxit=10; LP=100; 24 | UMDA=CEDA(copula="indep",margin="norm",popSize=LP,maxGen=maxit) 25 | UMDA@name="UMDA (LP=100)" 26 | setMethod("edaReport","EDA",edaReportDumpPop) # pop_*.txt files 27 | E=edaRun(UMDA,sphere,rep(-5.2,D),rep(5.2,D)) 28 | show(E) 29 | cat("best:",E@bestSol,"f:",E@bestEval,"\n") 30 | 31 | # read dumped files and create a plot: 32 | pdf("eda1.pdf",width=7,height=7) 33 | j=1; # j-th parameter 34 | i=1;d=read.table(paste("pop_",i,".txt",sep="")) 35 | plot(xlim=c(1,maxit),rep(1,LP),d[,j],pch=19, 36 | xlab="iterations",ylab=paste("s_",j," value",sep="")) 37 | for(i in 2:maxit) 38 | { d=read.table(paste("pop_",i,".txt",sep="")) 39 | points(rep(i,LP),d[,j],pch=19) 40 | } 41 | dev.off() 42 | -------------------------------------------------------------------------------- /Chapter5/sphere-genalg.R: -------------------------------------------------------------------------------- 1 | ### sphere-genalg.R file ### 2 | library(genalg) # load genalg 3 | 4 | # evolutionary algorithm for sphere: 5 | sphere=function(x) sum(x^2) 6 | D=2 7 | monitor=function(obj) 8 | { if(i==1) 9 | { plot(obj$population,xlim=c(-5.2,5.2),ylim=c(-5.2,5.2), 10 | xlab="x1",ylab="x2",type="p",pch=16, 11 | col=gray(1-i/maxit)) 12 | } 13 | else if(i%%K==0) points(obj$population,pch=16, 14 | col=gray(1-i/maxit)) 15 | i<<-i+1 # global update 16 | } 17 | 18 | maxit=100 19 | K=5 # store population values every K generations 20 | i=1 # initial generation 21 | 22 | # evolutionary algorithm execution: 23 | pdf("genalg2.pdf",width=5,height=5) 24 | set.seed(12345) # set for replicability purposes 25 | E=rbga(rep(-5.2,D),rep(5.2,D),popSize=5,iters=maxit, 26 | monitorFunc=monitor,evalFunc=sphere) 27 | b=which.min(E$evaluations) # best individual 28 | cat("best:",E$population[b,],"f:",E$evaluations[b],"\n") 29 | dev.off() 30 | -------------------------------------------------------------------------------- /Chapter5/sphere-psoptim.R: -------------------------------------------------------------------------------- 1 | ### sphere-psoptim.R file ### 2 | library(pso) # load pso 3 | 4 | sphere=function(x) sum(x^2) 5 | 6 | D=2; maxit=10; s=5 7 | set.seed(12345) # set for replicability 8 | C=list(trace=1,maxit=maxit,REPORT=1,trace.stats=1,s=s) 9 | # perform the optimization: 10 | PSO=psoptim(rep(NA,D),fn=sphere,lower=rep(-5.2,D), 11 | upper=rep(5.2,D),control=C) 12 | # result: 13 | pdf("psoptim1.pdf",width=5,height=5) 14 | j=1 # j-th parameter 15 | plot(xlim=c(1,maxit),rep(1,s),PSO$stats$x[[1]][j,],pch=19, 16 | xlab="iterations",ylab=paste("s_",j," value",sep="")) 17 | for(i in 2:maxit) points(rep(i,s),PSO$stats$x[[i]][j,],pch=19) 18 | dev.off() 19 | pdf("psoptim2.pdf",width=5,height=5) 20 | plot(PSO$stats$error,type="l",lwd=2,xlab="iterations", 21 | ylab="best fitness") 22 | dev.off() 23 | cat("best:",PSO$par,"f:",PSO$value,"\n") 24 | -------------------------------------------------------------------------------- /Chapter6/lg-ga.R: -------------------------------------------------------------------------------- 1 | ### lg-ga.R file ### 2 | 3 | # lexicographic comparison of several solutions: 4 | # x - is a matrix with several objectives at each column 5 | # and each row is related with a solution 6 | lexibest=function(x) # assumes LEXI is defined 7 | { 8 | size=nrow(x); m=ncol(x) 9 | candidates=1:size 10 | stop=FALSE; i=1 11 | while(!stop) 12 | { 13 | F=x[candidates,i] # i-th goal 14 | minFID=which.min(F) # minimization goal is assumed 15 | minF=F[minFID] 16 | # compute tolerance value 17 | if(minF>-1 && minF<1) tolerance=LEXI[i] 18 | else tolerance=abs(LEXI[i]*minF) 19 | I=which((F-minF)<=tolerance) 20 | if(length(I)>0) # at least one candidate 21 | candidates=candidates[I] # update candidates 22 | else stop=TRUE 23 | if(!stop && i==m) stop=TRUE 24 | else i=i+1 25 | } 26 | if(length(candidates)>1) 27 | { # return highest priority goal if no clear winner: 28 | stop=FALSE; i=1 29 | while(!stop) 30 | { 31 | minF=min(x[candidates,i]) 32 | I=which(x[candidates,i]==minF) 33 | candidates=candidates[I] 34 | if(length(candidates)==1||i==m) stop=TRUE 35 | else i=i+1 36 | } 37 | # remove (any) extra duplicate individuals: 38 | candidates=candidates[1] 39 | } 40 | # return lexibest: 41 | return(candidates) 42 | } 43 | 44 | # compare k randomly selected solutions from Population: 45 | # returns n best indexes of Population (decreasing order) 46 | # m is the number of objectives 47 | tournament=function(Population,evalFunc,k,n,m=2) 48 | { 49 | popSize=nrow(Population) 50 | PID=sample(1:popSize,k) # select k random tournament solutions 51 | E=matrix(nrow=k,ncol=m) # evaluations of tournament solutions 52 | for(i in 1:k) # evaluate tournament 53 | E[i,]=evalFunc(Population[PID[i],]) 54 | 55 | # return best n individuals: 56 | B=lexibest(E); i=1; res=PID[B] # best individual 57 | while(i0) # applying elitism: 107 | { 108 | elitismID=tournament(population,evalFunc,k=popSize,n=elitism) 109 | newPopulation[1:elitism,]=population[elitismID,] 110 | } 111 | # applying crossover: 112 | for(child in (elitism + 1):popSize) 113 | { 114 | ### very new code inserted here : ### 115 | pID1=tournament(population,evalFunc=evalFunc,k=2,n=1) 116 | pID2=tournament(population,evalFunc=evalFunc,k=2,n=1) 117 | parents=population[c(pID1,pID2),] 118 | ### end of very new code ### 119 | crossOverPoint=sample(0:vars, 1) 120 | if(crossOverPoint == 0) 121 | newPopulation[child,]=parents[2,] 122 | else if(crossOverPoint == vars) 123 | newPopulation[child, ]=parents[1, ] 124 | else 125 | { 126 | newPopulation[child,]=c(parents[1,][1:crossOverPoint],parents[2,][(crossOverPoint+1):vars]) 127 | while(sum(newPopulation[child,])==0) 128 | newPopulation[child, ]=sample(c(rep(0,zeroToOneRatio),1),vars,rep=TRUE) 129 | } 130 | } 131 | population=newPopulation # store new population 132 | if(mutationChance>0) # applying mutations: 133 | { 134 | mutationCount=0 135 | for(object in (elitism+1):popSize) 136 | { 137 | for(var in 1:vars) 138 | { 139 | if(runif(1)< mutationChance) 140 | { 141 | population[object, var]=sample(c(rep(0,zeroToOneRatio),1),1) 142 | mutationCount=mutationCount+1 143 | } 144 | } 145 | } 146 | } 147 | } # end of GA main cycle 148 | result=list(type="binary chromosome",size=size,popSize=popSize, 149 | iters=iters,suggestions=suggestions, 150 | population=population,elitism=elitism, 151 | mutationChance=mutationChance) 152 | return(result) 153 | } 154 | -------------------------------------------------------------------------------- /Chapter6/lg-test.R: -------------------------------------------------------------------------------- 1 | ### lg-test.R file ### 2 | 3 | source("mo-tasks.R") # load multi-optimization tasks 4 | source("lg-ga.R") # load lrgba.bin 5 | set.seed(12345) # set for replicability 6 | 7 | LEXI=c(0.2,0.2) # tolerance 20% for each goal 8 | cat("tolerance thresholds:",LEXI,"\n") 9 | 10 | # --- binary task: 11 | D=8 # 8 bits 12 | # eval: transform binary objectives into minimization goal 13 | # returns a vector with 2 values, one per objective: 14 | eval=function(x) return(c(-sumbin(x),-maxsin(x))) 15 | popSize=12 16 | G=lrbga.bin(size=D,popSize=popSize,iters=100,zeroToOneRatio=1, 17 | evalFunc=eval,elitism=1) 18 | print("Ranking of last population:") 19 | B=tournament(G$population,eval,k=popSize,n=popSize,m=2) 20 | for(i in 1:popSize) 21 | { 22 | x=G$population[B[i],] 23 | cat(x," f=(",sumbin(x),",",round(maxsin(x),2),")","\n",sep="") 24 | } 25 | -------------------------------------------------------------------------------- /Chapter6/mo-tasks.R: -------------------------------------------------------------------------------- 1 | ### mo-tasks.R file ### 2 | 3 | # binary multi-optimization goal: 4 | sumbin=function(x) (sum(x)) 5 | intbin=function(x) sum(2^(which(rev(x==1))-1)) 6 | maxsin=function(x) # max sin (explained in Chapter 3) 7 | { D=length(x);x=intbin(x) 8 | return(sin(pi*(as.numeric(x))/(2^D))) } 9 | 10 | # integer multi-optimization goal: 11 | profit=function(x) # x - a vector of prices 12 | { x=round(x,digits=0) # convert x into integer 13 | s=sales(x) # get the expected sales 14 | c=cost(s) # get the expected cost 15 | profit=sum(s*x-c) # compute the profit 16 | return(profit) 17 | } 18 | cost=function(units,A=100,cpu=35-5*(1:length(units))) 19 | { return(A+cpu*units) } 20 | sales=function(x,A=1000,B=200,C=141, 21 | m=seq(2,length.out=length(x),by=-0.25)) 22 | { return(round(m*(A/log(x+B)-C),digits=0))} 23 | produced=function(x) sum(sales(round(x))) 24 | 25 | # real value FES1 benchmark: 26 | fes1=function(x) 27 | { D=length(x);f1=0;f2=0 28 | for(i in 1:D) 29 | { f1=f1+abs(x[i]-exp((i/D)^2)/3)^0.5 30 | f2=f2+(x[i]-0.5*cos(10*pi/D)-0.5)^2 31 | } 32 | return(c(f1,f2)) 33 | } 34 | -------------------------------------------------------------------------------- /Chapter6/nsga2-test.R: -------------------------------------------------------------------------------- 1 | ### nsga2-test.R file ### 2 | 3 | source("mo-tasks.R") # load multi-optimization tasks 4 | library(mco) # load mco package 5 | 6 | set.seed(12345) # set for replicability 7 | m=2 # two objectives 8 | 9 | # --- binary task: 10 | D=8 # 8 bits 11 | # eval: transform binary objectives into minimization goal 12 | # round(x) is used to convert real number to 0 or 1 values 13 | eval=function(x) c(-sumbin(round(x)),-maxsin(round(x))) 14 | cat("binary task:\n") 15 | G=nsga2(fn=eval,idim=D,odim=m, 16 | lower.bounds=rep(0,D),upper.bounds=rep(1,D), 17 | popsize=12,generations=100) 18 | # show last Pareto front 19 | I=which(G$pareto.optimal) 20 | for(i in I) 21 | { 22 | x=round(G$par[i,]) 23 | cat(x," f=(",sumbin(x),",",round(maxsin(x),2),")","\n",sep="") 24 | } 25 | 26 | # --- integer task: 27 | D=5 # 5 bag prices 28 | # eval: transform objectives into minimization goal 29 | eval=function(x) c(-profit(x),produced(x)) 30 | cat("integer task:\n") 31 | G=nsga2(fn=eval,idim=5,odim=m, 32 | lower.bounds=rep(1,D),upper.bounds=rep(1000,D), 33 | popsize=20,generations=1:100) 34 | # show best individuals: 35 | I=which(G[[100]]$pareto.optimal) 36 | for(i in I) 37 | { 38 | x=round(G[[100]]$par[i,]) 39 | cat(x," f=(",profit(x),",",produced(x),")","\n",sep=" ") 40 | } 41 | # create PDF with Pareto front evolution: 42 | pdf(file="nsga-bag.pdf",paper="special",height=5,width=5) 43 | par(mar=c(4.0,4.0,0.1,0.1)) 44 | I=1:100 45 | for(i in I) 46 | { P=G[[i]]$value # objectives f1 and f2 47 | P[,1]=-1*P[,1] # show positive f1 values 48 | # color from light gray (75) to dark (1): 49 | COL=paste("gray",round(76-i*0.75),sep="") 50 | if(i==1) plot(P,xlim=c(-500,44000),ylim=c(0,140), 51 | xlab="f1",ylab="f2",cex=0.5,col=COL) 52 | Pareto=P[G[[i]]$pareto.optimal,] 53 | # sort Pareto according to x axis: 54 | I=sort.int(Pareto[,1],index.return=TRUE) 55 | Pareto=Pareto[I$ix,] 56 | points(P,type="p",pch=1,cex=0.5,col=COL) 57 | lines(Pareto,type="l",cex=0.5,col=COL) 58 | } 59 | dev.off() 60 | 61 | # create PDF comparing NSGA-II with WF: 62 | pdf(file="nsga-bag2.pdf",paper="special",height=5,width=5) 63 | par(mar=c(4.0,4.0,0.1,0.1)) 64 | # NSGA-II best results: 65 | P=G[[100]]$value # objectives f1 and f2 66 | P[,1]=-1*P[,1] # show positive f1 values 67 | Pareto=P[G[[100]]$pareto.optimal,] 68 | # sort Pareto according to x axis: 69 | I=sort.int(Pareto[,1],index.return=TRUE) 70 | plot(Pareto[I$ix,],xlim=c(-500,44000),ylim=c(0,140), 71 | xlab="f1",ylab="f2",type="b",lwd=2,lty=1,pch=1) 72 | # weight-formula best results: 73 | wf=read.table("wf-bag.csv",sep=" ") 74 | I=sort.int(wf[,1],index.return=TRUE) 75 | lines(wf[I$ix,],type="b",lty=2,lwd=2,pch=3) 76 | legend("topleft",c("NSGA-II","weighted-formula"), 77 | lwd=2,lty=1:2,pch=c(1,3)) 78 | dev.off() 79 | 80 | # --- real value task: 81 | D=8 # dimension 82 | cat("real value task:\n") 83 | G=nsga2(fn=fes1,idim=D,odim=m, 84 | lower.bounds=rep(0,D),upper.bounds=rep(1,D), 85 | popsize=20,generations=1:100) 86 | # show best individuals: 87 | I=which(G[[100]]$pareto.optimal) 88 | for(i in I) 89 | { 90 | x=round(G[[100]]$par[i,],digits=2); cat(x) 91 | cat(" f=(",round(fes1(x)[1],2),",",round(fes1(x)[2],2),")","\n",sep="") 92 | } 93 | # create PDF with Pareto front evolution: 94 | pdf(file="nsga-fes1.pdf",paper="special",height=5,width=5) 95 | par(mar=c(4.0,4.0,0.1,0.1)) 96 | I=1:100 97 | for(i in I) 98 | { P=G[[i]]$value # objectives f1 and f2 99 | # color from light gray (75) to dark (1): 100 | COL=paste("gray",round(76-i*0.75),sep="") 101 | if(i==1) plot(P,xlim=c(0.5,5.0),ylim=c(0,2.0), 102 | xlab="f1",ylab="f2",cex=0.5,col=COL) 103 | Pareto=P[G[[i]]$pareto.optimal,] 104 | # sort Pareto according to x axis: 105 | I=sort.int(Pareto[,1],index.return=TRUE) 106 | Pareto=Pareto[I$ix,] 107 | points(P,type="p",pch=1,cex=0.5,col=COL) 108 | lines(Pareto,type="l",cex=0.5,col=COL) 109 | } 110 | dev.off() 111 | 112 | # create PDF comparing NSGA-II with WF: 113 | pdf(file="nsga-fes1-2.pdf",paper="special",height=5,width=5) 114 | par(mar=c(4.0,4.0,0.1,0.1)) 115 | # NSGA-II best results: 116 | P=G[[100]]$value # objectives f1 and f2 117 | Pareto=P[G[[100]]$pareto.optimal,] 118 | # sort Pareto according to x axis: 119 | I=sort.int(Pareto[,1],index.return=TRUE) 120 | plot(Pareto[I$ix,],xlim=c(0.5,5.0),ylim=c(0,2.0), 121 | xlab="f1",ylab="f2",type="b",lwd=2,pch=1) 122 | # weight-formula best results: 123 | wf=read.table("wf-fes1.csv",sep=" ") 124 | I=sort.int(wf[,1],index.return=TRUE) 125 | lines(wf[I$ix,],type="b",lty=2,lwd=2,pch=3) 126 | legend("top",c("NSGA-II","weighted-formula"), 127 | lwd=2,lty=1:2,pch=c(1,3)) 128 | dev.off() 129 | -------------------------------------------------------------------------------- /Chapter6/tsf.R: -------------------------------------------------------------------------------- 1 | ### tsf.R file ### 2 | library(RCurl) # load RCurl package 3 | 4 | # get sunspot series 5 | txt=getURL("http://sidc.oma.be/silso/DATA/yearssn.dat") 6 | # consider 1700-2012 years (remove 2013 * row that is provisory in 2014) 7 | series=strsplit(txt,"\n")[[1]][1:(2012-1700+1)] 8 | cat(series,sep="\n",file="sunspots.dat") # save to file 9 | series=read.table("sunspots.dat")[,2] # read from file 10 | 11 | L=length(series) # series length 12 | forecasts=32 # number of 1-ahead forecasts 13 | outsamples=series[(L-forecasts+1):L] # out-of-samples 14 | sunspots=series[1:(L-forecasts)] # in-samples 15 | 16 | # mean absolute error of residuals 17 | maeres=function(residuals) mean(abs(residuals)) 18 | 19 | # fit best ARIMA model: 20 | INIT=10 # initialization period (no error computed before) 21 | library(forecast) # load forecast package 22 | arima=auto.arima(sunspots) # detected order is AR=2, MA=1 23 | print(arima) # show ARIMA model 24 | cat("arima fit MAE=", 25 | maeres(arima$residuals[INIT:length(sunspots)]),"\n") 26 | # one-step ahead forecasts: 27 | # (this code is needed because forecast function 28 | # only issues h-ahead forecasts) 29 | LIN=length(sunspots) # length of in-samples 30 | f1=rep(NA,forecasts) 31 | for(h in 1:forecasts) 32 | { # execute arima with fixed coefficients but with more in-samples: 33 | arima1=arima(series[1:(LIN+h-1)],order=arima$arma[c(1,3,2)],fixed=arima$coef) 34 | f1[h]=forecast(arima1,h=1)$mean[1] 35 | } 36 | e1=maeres(outsamples-f11) 37 | text1=paste("arima (MAE=",round(e1,digits=1),")",sep="") 38 | 39 | # fit genetic programming arithmetic model: 40 | library(rgp) # load rgp 41 | ST=inputVariableSet("x1","x2") # same order of AR arima component 42 | cF1=constantFactorySet(function() rnorm(1)) # mean=0, sd=1 43 | FS=functionSet("+","*","-","/") # arithmetic 44 | 45 | # genetic programming time series function 46 | # receives function f 47 | # if(h>0) then returns 1-ahead forecasts 48 | # else returns MAE over fitting period (in-samples) 49 | gpts=function(f,h=0) 50 | { 51 | if(h>0) TS=series 52 | else TS=series[1:LIN] 53 | LTS=length(TS) 54 | F=rep(0,LTS) # forecasts 55 | E=rep(0,LTS) # residuals 56 | if(h>0) I=(LTS-h+1):LTS # h forecasts 57 | else I=INIT:LTS # fit to in-samples 58 | for(i in I) 59 | { 60 | F[i]=f(TS[i-1],TS[i-2]) 61 | if(is.nan(F[i])) F[i]=0 # deal with NaN 62 | E[i]=TS[i]-F[i] 63 | } 64 | if(h>0) return (F[I]) # forecasts 65 | else return(maeres(E[I])) # MAE on fit 66 | } 67 | 68 | # mutation function 69 | mut=function(func) 70 | { mutateSubtree(func,funcset=FS,inset=ST,conset=cF1, 71 | mutatesubtreeprob=0.3,maxsubtreedepth=4)} 72 | 73 | set.seed(12345) # set for replicability 74 | gp=geneticProgramming(functionSet=FS,inputVariables=ST, 75 | constantSet=cF1, 76 | populationSize=100, 77 | fitnessFunction=gpts, 78 | stopCondition=makeStepsStopCondition(1000), 79 | mutationFunction=mut, 80 | verbose=TRUE) 81 | f2=gpts(gp$population[[which.min(gp$fitnessValues)]],h=forecasts) 82 | e2=maeres(outsamples-f2) 83 | 84 | text2=paste("gp (MAE=",round(e2,digits=1),")",sep="") 85 | cat("best solution:\n") 86 | print(gp$population[[which.min(gp$fitnessValues)]]) 87 | cat("gp fit MAE=",min(gp$fitnessValues),"\n") 88 | 89 | # show quality of one-step ahead forecasts: 90 | ymin=min(c(outsamples,f1,f2)) 91 | ymax=max(c(outsamples,f1,f2)) 92 | pdf("fsunspots.pdf") 93 | par(mar=c(4.0,4.0,0.1,0.1)) 94 | plot(outsamples,ylim=c(ymin,ymax),type="b",pch=1, 95 | xlab="time (years after 1980)",ylab="values",cex=0.8) 96 | lines(f1,lty=2,type="b",pch=3,cex=0.5) 97 | lines(f2,lty=3,type="b",pch=5,cex=0.5) 98 | legend("topright",c("sunspots",text1,text2),lty=1:3,pch=c(1,3,5)) 99 | dev.off() 100 | -------------------------------------------------------------------------------- /Chapter6/tsp.R: -------------------------------------------------------------------------------- 1 | ### tsp.R file ### 2 | 3 | library(TSP) # load TSP package 4 | library(RCurl) # load RCurl package 5 | source("oea.R") # load ordered evolutionary algorithm 6 | 7 | # get Qatar - 194 cities TSP instance: 8 | txt=getURL("http://www.math.uwaterloo.ca/tsp/world/qa194.tsp") 9 | # simple parse of txt object, removing header and last line: 10 | txt=strsplit(txt,"NODE_COORD_SECTION") # split text into 2 parts 11 | txt=txt[[1]][2] # get second text part 12 | txt=strsplit(txt,"EOF") # split text into 2 parts 13 | txt=txt[[1]][1] # get first text part 14 | # save data into a simple .csv file, sep=" ": 15 | cat(txt,file="qa194.csv") 16 | # read the TSP format into Data 17 | # (first row is empty, thus header=TRUE) 18 | # get city Cartesian coordinates 19 | 20 | Data=read.table("qa194.csv",sep=" ") 21 | Data=Data[,3:2] # longitude and latitude 22 | names(Data)=c("x","y") # x and y labels 23 | N=nrow(Data) # number of cities 24 | 25 | # distance between two cities (EUC_2D-norm) 26 | # Eulidean distance rounded to whole number 27 | D=dist(Data,upper=TRUE) 28 | D[1:length(D)]=round(D[1:length(D)]) 29 | # create TSP object from D: 30 | TD=TSP(D) 31 | 32 | set.seed(12345) # for replicability 33 | cat("2-opt run:\n") 34 | PTM=proc.time() # start clock 35 | R1=solve_TSP(TD,method="2-opt") 36 | sec=(proc.time()-PTM)[3] # get seconds elapsed 37 | print(R1) # show optimum 38 | cat("time elapsed:",sec,"\n") 39 | 40 | MAXIT=100000 41 | Methods=c("SANN","EA","LEA") # comparison of 3 methods 42 | RES=matrix(nrow=MAXIT,ncol=length(Methods)) 43 | MD=as.matrix(D) 44 | 45 | # overall distance of a tour (evaluation function): 46 | tour=function(s) 47 | { # compute tour length: 48 | EV<<-EV+1 # increase evaluations 49 | s=c(s,s[1]) # start city is also end city 50 | res=0 51 | for(i in 2:length(s)) res=res+MD[s[i],s[i-1]] 52 | # store memory with best values: 53 | if(resN) res=res-N 64 | return(res) 65 | } 66 | 67 | # local improvement and evaluation: 68 | # first tries to improve a solution with a 69 | # local search that uses domain knowledge (MD) 70 | # returns best solution and evaluation value 71 | local_imp_tour=function(s,p=NA) 72 | { # local search 73 | N=length(s); ALL=1:N 74 | if(is.na(p)) p=sample(ALL,1) # select random position 75 | I=setdiff(ALL,p) 76 | 77 | # current distance: p to neighbors 78 | pprev=mindex(p,-1,N=N); pnext=mindex(p,1,N=N) 79 | dpcur=MD[s[pprev],s[p]]+MD[s[p],s[pnext]] 80 | # new distance if p is remove to another position: 81 | dpnew=MD[s[pprev],s[pnext]] 82 | 83 | # search for best insertion position for p: 84 | ibest=0;best=-Inf 85 | for(i in I) # extra cycle that increases computation 86 | { 87 | inext=mindex(i,1,N=N);iprev=mindex(i,-1,N=N) 88 | if(inext==p) inext=pnext 89 | if(iprev==p) iprev=pprev 90 | # dinew: new distance p to neighbors if p inserted: 91 | # current i distance without p: 92 | if(i0 && dif>best) # improved solution 103 | { 104 | best=dif 105 | ibest=i 106 | } 107 | } 108 | 109 | if(ibest>0) # insert p in i 110 | s=insertion(s,p=p,i=ibest) 111 | return(list(eval=tour(s),solution=s)) 112 | } 113 | 114 | # SANN: 115 | cat("SANN run:\n") 116 | set.seed(12345) # for replicability 117 | s=sample(1:N,N) # initial solution 118 | EV=0; BEST=Inf; F=rep(NA,MAXIT) # reset these vars. 119 | C=list(maxit=MAXIT,temp=2000,trace=TRUE,REPORT=MAXIT) 120 | PTM=proc.time() # start clock 121 | SANN=optim(s,fn=tour,gr=insertion,method="SANN",control=C) 122 | sec=(proc.time()-PTM)[3] # get seconds elapsed 123 | cat("time elapsed:",sec,"\n") 124 | RES[,1]=F 125 | 126 | # EA: 127 | cat("EA run:\n") 128 | set.seed(12345) # for replicability 129 | EV=0; BEST=Inf; F=rep(NA,MAXIT) # reset these vars. 130 | pSize=30;iters=ceiling((MAXIT-pSize)/(pSize-1)) 131 | PTM=proc.time() # start clock 132 | OEA=oea(size=N,popSize=pSize,iters=iters,evalFunc=tour,crossfunc=ox,mutfunc=insertion,REPORT=iters,elitism=1) 133 | sec=(proc.time()-PTM)[3] # get seconds elapsed 134 | cat("time elapsed:",sec,"\n") 135 | RES[,2]=F 136 | 137 | # Lamarckian EA (LEA): 138 | cat("LEA run:\n") 139 | set.seed(12345) # for replicability 140 | EV=0; BEST=Inf; F=rep(NA,MAXIT) # reset these vars. 141 | pSize=30;iters=ceiling((MAXIT-pSize)/(pSize-1)) 142 | PTM=proc.time() # start clock 143 | LEA=oea(size=N,popSize=pSize,iters=iters,evalFunc=local_imp_tour,crossfunc=ox,mutfunc=insertion,REPORT=iters,elitism=1) 144 | sec=(proc.time()-PTM)[3] # get seconds elapsed 145 | cat("time elapsed:",sec,"\n") 146 | RES[,3]=F 147 | 148 | # create PDF with comparison: 149 | pdf("qa194-opt.pdf",paper="special") 150 | par(mar=c(4.0,4.0,0.1,0.1)) 151 | X=seq(1,MAXIT,length.out=200) 152 | ylim=c(min(RES)-50,max(RES)) 153 | plot(X,RES[X,1],ylim=ylim,type="l",lty=3,lwd=2,xlab="evaluations",ylab="tour distance") 154 | lines(X,RES[X,2],type="l",lty=2,lwd=2) 155 | lines(X,RES[X,3],type="l",lty=1,lwd=2) 156 | legend("topright",Methods,lwd=2,lty=3:1) 157 | dev.off() 158 | 159 | # create 3 PDF files with best tours: 160 | pdf("qa194-2-opt.pdf",paper="special") 161 | par(mar=c(0.0,0.0,0.0,0.0)) 162 | plot(Data[c(R1[1:N],R1[1]),],type="l",xaxt="n",yaxt="n") 163 | dev.off() 164 | pdf("qa194-ea.pdf",paper="special") 165 | par(mar=c(0.0,0.0,0.0,0.0)) 166 | b=OEA$population[which.min(OEA$evaluations),] 167 | plot(Data[c(b,b[1]),],type="l",xaxt="n",yaxt="n") 168 | dev.off() 169 | pdf("qa194-lea.pdf",paper="special") 170 | par(mar=c(0.0,0.0,0.0,0.0)) 171 | b=LEA$population[which.min(LEA$evaluations),] 172 | plot(Data[c(b,b[1]),],type="l",xaxt="n",yaxt="n") 173 | dev.off() 174 | -------------------------------------------------------------------------------- /Chapter6/wf-test.R: -------------------------------------------------------------------------------- 1 | ### wf-test.R file ### 2 | 3 | source("mo-tasks.R") # load multi-optimization tasks 4 | library(genalg) # load genalg package 5 | 6 | set.seed(12345) # set for replicability 7 | 8 | step=5 # number of weight combinations 9 | w=matrix(ncol=2,nrow=step) # weight combinations 10 | w[,1]=seq(1,0,length.out=step) 11 | w[,2]=1-w[,1] 12 | 13 | print("Weight combinations:") 14 | print(w) 15 | # --- binary task: 16 | D=8 # 8 bits 17 | eval=function(x) return(W[1]*sumbin(x)+W[2]*maxsin(x)) 18 | cat("binary task:\n") 19 | for(i in 1:step) 20 | { 21 | W= -w[i,] # rbga.bin minimization goal: max. f1 and max. f2 22 | G=rbga.bin(size=D,popSize=12,iters=100,zeroToOneRatio=1, 23 | evalFunc=eval,elitism=1) 24 | b=G$population[which.min(G$evaluations),] # best individual 25 | cat("w",i,"best:",b) 26 | cat(" f=(",sumbin(b),",",round(maxsin(b),2),")","\n",sep="") 27 | } 28 | 29 | # --- integer task: 30 | D=5 # 5 bag prices 31 | eval=function(x) return(W[1]*profit(x)+W[2]*produced(x)) 32 | cat("integer task:\n") 33 | res=matrix(nrow=nrow(w),ncol=ncol(w)) # for CSV files 34 | for(i in 1:step) 35 | { 36 | W=c(-w[i,1],w[i,2]) # rbga min. goal: max. f1 and min. f2 37 | G=rbga(evalFunc=eval,stringMin=rep(1,D),stringMax=rep(1000,D), 38 | popSize=20,iters=100) 39 | b=round(G$population[which.min(G$evaluations),]) # best 40 | cat("w",i,"best:",b) 41 | cat(" f=(",profit(b),",",produced(b),")","\n",sep="") 42 | res[i,]=c(profit(b),produced(b)) 43 | } 44 | write.table(res,"wf-bag.csv", 45 | row.names=FALSE,col.names=FALSE,sep=" ") 46 | # --- real value task: 47 | D=8 # dimension 48 | eval=function(x) return(sum(W*fes1(x))) 49 | cat("real value task:\n") 50 | for(i in 1:step) 51 | { 52 | W=w[i,] # rbga minimization goal 53 | G=rbga(evalFunc=eval,stringMin=rep(0,D),stringMax=rep(1,D), 54 | popSize=20,iters=100) 55 | b=G$population[which.min(G$evaluations),] # best solution 56 | cat("w",i,"best:",round(b,2)) 57 | cat(" f=(",round(fes1(b)[1],2),",",round(fes1(b)[2],2),")","\n",sep="") 58 | res[i,]=fes1(b) 59 | } 60 | write.table(res,"wf-fes1.csv", 61 | row.names=FALSE,col.names=FALSE,sep=" ") 62 | -------------------------------------------------------------------------------- /Chapter7/oea.R: -------------------------------------------------------------------------------- 1 | ### oea.R file ### 2 | 3 | ### mutation operators: 4 | exchange=function(s,N=length(s)) 5 | { p=sample(1:N,2) # select two positions 6 | temp=s[p[1]] # swap values 7 | s[p[1]]=s[p[2]] 8 | s[p[2]]=temp 9 | return(s) 10 | } 11 | 12 | insertion=function(s,N=length(s),p=NA,i=NA) 13 | { if(is.na(p)) p=sample(1:N,1) # select a position 14 | I=setdiff(1:N,p) # ALL except p 15 | if(is.na(i)) i=sample(I,1) # select random place 16 | if(i>p) i=i+1 # need to produce a change 17 | I1=which(I=i) # last part 19 | s=s[c(I[I1],p,I[I2])] # new solution 20 | return(s) 21 | } 22 | 23 | displacement=function(s,N=length(s)) 24 | { p=c(1,N) 25 | # select random tour different than s 26 | while(p[1]==1&&p[2]==N) p=sort(sample(1:N,2)) 27 | I=setdiff(1:N,p[1]:p[2]) # ALL except p 28 | i=sample(I,1) # select random place 29 | I1=which(I=i) # last part 31 | s=s[c(I[I1],p[1]:p[2],I[I2])] 32 | return(s) 33 | } 34 | 35 | ### crossover operators: 36 | # partially matched crossover (PMX) operator: 37 | # m is a matrix with 2 parent x ordered solutions 38 | pmx=function(m) 39 | { 40 | N=ncol(m) 41 | p=sample(1:N,2) # two cutting points 42 | c=m # children 43 | for(i in p[1]:p[2]) 44 | { # rearrange: 45 | c[1,which(c[1,]==m[2,i])]=c[1,i] 46 | # crossed section: 47 | c[1,i]=m[2,i] 48 | # rearrange: 49 | c[2,which(c[2,]==m[1,i])]=c[2,i] 50 | # crossed section: 51 | c[2,i]=m[1,i] 52 | } 53 | return(c) 54 | } 55 | 56 | # order crossover (OX) operator: 57 | # m is a matrix with 2 parent x ordered solutions 58 | ox=function(m) 59 | { 60 | N=ncol(m) 61 | p=sort(sample(1:N,2)) # two cutting points 62 | c=matrix(rep(NA,N*2),ncol=N) 63 | # keep selected section: 64 | c[,p[1]:p[2]]=m[,p[1]:p[2]] 65 | # rotate after cut 2 (p[2]): 66 | I=((p[2]+1):(p[2]+N)) 67 | I=ifelse(I<=N,I,I-N) 68 | a=m[,I] 69 | # fill remaining genes: 70 | a1=setdiff(a[2,],c[1,p[1]:p[2]]) 71 | a2=setdiff(a[1,],c[2,p[1]:p[2]]) 72 | I2=setdiff(I,p[1]:p[2]) 73 | c[,I2]=rbind(a1,a2) 74 | return(c) 75 | } 76 | 77 | ### order (representation) evolutionary algorithm: 78 | # adapted version of rbga.bin that works with ordered vectors, 79 | # accepts used defined mutation and crossover operators and 80 | # accepts a Lamarckian evolution if evalFunc returns a list 81 | # note: assumes solution with values from the range 1,2,...,size 82 | oea=function(size=10,suggestions=NULL,popSize=200,iters=100,mutationChance=NA, 83 | elitism=NA,evalFunc=NULL, 84 | crossfunc=NULL,mutfunc=mutfunc,REPORT=0) 85 | { 86 | if(is.na(mutationChance)) { mutationChance=0.5 } 87 | if(is.na(elitism)) { elitism=floor(popSize/5)} 88 | 89 | # population initialization: 90 | population=matrix(nrow=popSize,ncol=size) 91 | if(!is.null(suggestions)) 92 | { 93 | suggestionCount=dim(suggestions)[1] 94 | for(i in 1:suggestionCount) 95 | population[i, ] = suggestions[i, ] 96 | I=(suggestionCount+1):popSize ### new code 97 | } 98 | else I=1:popSize ### new code 99 | for(child in I) ### new code 100 | population[child,]=sample(1:size,size) ### new code 101 | 102 | # evaluate population: 103 | evalVals = rep(NA, popSize) 104 | # main GA cycle: 105 | for(iter in 1:iters) 106 | { 107 | # evaluate population 108 | for(object in 1:popSize) 109 | {### new code 110 | EF = evalFunc(population[object,]) 111 | if(is.list(EF)) # Lamarckian change of solution 112 | { population[object,]=EF$solution 113 | evalVals[object] = EF$eval 114 | } 115 | else evalVals[object]=EF 116 | ### end of new code 117 | } 118 | sortedEvaluations=sort(evalVals,index=TRUE) 119 | if(REPORT>0 && (iter%%REPORT==0||iter==1)) 120 | cat(iter,"best:",sortedEvaluations$x[1],"mean:",mean(sortedEvaluations$x),"\n") 121 | sortedPopulation=matrix(population[sortedEvaluations$ix,],ncol=size) 122 | 123 | # check elitism: 124 | newPopulation=matrix(nrow=popSize,ncol=size) 125 | if(elitism>0) # applying elitism: 126 | newPopulation[1:elitism,]=sortedPopulation[1:elitism,] 127 | 128 | ### very new code inserted here : ### 129 | # roulette wheel selection of remaining individuals 130 | others=popSize-elitism 131 | prob=(max(sortedEvaluations$x)-sortedEvaluations$x+1) 132 | prob=prob/sum(prob) # such that sum(prob)==1 133 | 134 | # crossover with half of the population (if !is.null) 135 | if(!is.null(crossfunc)) # need to crossover 136 | half=round(others/2) 137 | else half=0 # no crossover 138 | if(!is.null(crossfunc)) 139 | { 140 | for(child in seq(1,half,by=2)) 141 | { 142 | selIDs=sample(1:popSize,2,prob=prob) 143 | parents=sortedPopulation[selIDs, ] 144 | if(child==half) 145 | newPopulation[elitism+child,]=crossfunc(parents)[1,] # 1st child 146 | else 147 | newPopulation[elitism+child:(child+1),]=crossfunc(parents) # two children 148 | } 149 | } 150 | # mutation with remaining individuals 151 | for(child in (half+1):others) 152 | { 153 | selIDs=sample(1:popSize,1,prob=prob) 154 | newPopulation[elitism+child,]=mutfunc(sortedPopulation[selIDs,]) 155 | } 156 | ### end of very new code ### 157 | population=newPopulation # store new population 158 | 159 | } # end of GA main cycle 160 | result=list(type="ordered chromosome",size=size,popSize=popSize, 161 | iters=iters,population=population,elitism=elitism, 162 | mutationChance=mutationChance,evaluations=evalVals) 163 | return(result) 164 | } 165 | -------------------------------------------------------------------------------- /Chapter7/tsf.R: -------------------------------------------------------------------------------- 1 | ### tsf.R file ### 2 | 3 | # note: the book results were achieved with rgp package version 0.3-4 4 | # and current rgp package (0.4-0) produces slightly different results 5 | # (I got "gp fit MAE= 13.96245" after updating the rgp package) 6 | 7 | library(RCurl) # load RCurl package 8 | 9 | # get sunspot series 10 | txt=getURL("http://sidc.oma.be/silso/DATA/yearssn.dat") 11 | # consider 1700-2012 years (remove 2013 * row that is provisory in 2014) 12 | series=strsplit(txt,"\n")[[1]][1:(2012-1700+1)] 13 | cat(series,sep="\n",file="sunspots.dat") # save to file 14 | series=read.table("sunspots.dat")[,2] # read from file 15 | 16 | L=length(series) # series length 17 | forecasts=32 # number of 1-ahead forecasts 18 | outsamples=series[(L-forecasts+1):L] # out-of-samples 19 | sunspots=series[1:(L-forecasts)] # in-samples 20 | 21 | # mean absolute error of residuals 22 | maeres=function(residuals) mean(abs(residuals)) 23 | 24 | # fit best ARIMA model: 25 | INIT=10 # initialization period (no error computed before) 26 | library(forecast) # load forecast package 27 | arima=auto.arima(sunspots) # detected order is AR=2, MA=1 28 | print(arima) # show ARIMA model 29 | cat("arima fit MAE=", 30 | maeres(arima$residuals[INIT:length(sunspots)]),"\n") 31 | # one-step ahead forecasts: 32 | # (this code is needed because forecast function 33 | # only issues h-ahead forecasts) 34 | LIN=length(sunspots) # length of in-samples 35 | f1=rep(NA,forecasts) 36 | for(h in 1:forecasts) 37 | { # execute arima with fixed coefficients but with more in-samples: 38 | arima1=arima(series[1:(LIN+h-1)],order=arima$arma[c(1,3,2)],fixed=arima$coef) 39 | f1[h]=forecast(arima1,h=1)$mean[1] 40 | } 41 | e1=maeres(outsamples-f1) 42 | text1=paste("arima (MAE=",round(e1,digits=1),")",sep="") 43 | 44 | # fit genetic programming arithmetic model: 45 | library(rgp) # load rgp 46 | ST=inputVariableSet("x1","x2") # same order of AR arima component 47 | cF1=constantFactorySet(function() rnorm(1)) # mean=0, sd=1 48 | FS=functionSet("+","*","-","/") # arithmetic 49 | 50 | # genetic programming time series function 51 | # receives function f 52 | # if(h>0) then returns 1-ahead forecasts 53 | # else returns MAE over fitting period (in-samples) 54 | gpts=function(f,h=0) 55 | { 56 | if(h>0) TS=series 57 | else TS=series[1:LIN] 58 | LTS=length(TS) 59 | F=rep(0,LTS) # forecasts 60 | E=rep(0,LTS) # residuals 61 | if(h>0) I=(LTS-h+1):LTS # h forecasts 62 | else I=INIT:LTS # fit to in-samples 63 | for(i in I) 64 | { 65 | F[i]=f(TS[i-1],TS[i-2]) 66 | if(is.nan(F[i])) F[i]=0 # deal with NaN 67 | E[i]=TS[i]-F[i] 68 | } 69 | if(h>0) return (F[I]) # forecasts 70 | else return(maeres(E[I])) # MAE on fit 71 | } 72 | 73 | # mutation function 74 | mut=function(func) 75 | { mutateSubtree(func,funcset=FS,inset=ST,conset=cF1, 76 | mutatesubtreeprob=0.3,maxsubtreedepth=4)} 77 | 78 | set.seed(12345) # set for replicability 79 | gp=geneticProgramming(functionSet=FS,inputVariables=ST, 80 | constantSet=cF1, 81 | populationSize=100, 82 | fitnessFunction=gpts, 83 | stopCondition=makeStepsStopCondition(1000), 84 | mutationFunction=mut, 85 | verbose=TRUE) 86 | f2=gpts(gp$population[[which.min(gp$fitnessValues)]],h=forecasts) 87 | e2=maeres(outsamples-f2) 88 | 89 | text2=paste("gp (MAE=",round(e2,digits=1),")",sep="") 90 | cat("best solution:\n") 91 | print(gp$population[[which.min(gp$fitnessValues)]]) 92 | cat("gp fit MAE=",min(gp$fitnessValues),"\n") 93 | 94 | # show quality of one-step ahead forecasts: 95 | ymin=min(c(outsamples,f1,f2)) 96 | ymax=max(c(outsamples,f1,f2)) 97 | pdf("fsunspots.pdf") 98 | par(mar=c(4.0,4.0,0.1,0.1)) 99 | plot(outsamples,ylim=c(ymin,ymax),type="b",pch=1, 100 | xlab="time (years after 1980)",ylab="values",cex=0.8) 101 | lines(f1,lty=2,type="b",pch=3,cex=0.5) 102 | lines(f2,lty=3,type="b",pch=5,cex=0.5) 103 | legend("topright",c("sunspots",text1,text2),lty=1:3,pch=c(1,3,5)) 104 | dev.off() 105 | -------------------------------------------------------------------------------- /Chapter7/tsp.R: -------------------------------------------------------------------------------- 1 | ### tsp.R file ### 2 | 3 | library(TSP) # load TSP package 4 | library(RCurl) # load RCurl package 5 | source("oea.R") # load ordered evolutionary algorithm 6 | 7 | # get Qatar - 194 cities TSP instance: 8 | txt=getURL("http://www.math.uwaterloo.ca/tsp/world/qa194.tsp") 9 | # simple parse of txt object, removing header and last line: 10 | txt=strsplit(txt,"NODE_COORD_SECTION") # split text into 2 parts 11 | txt=txt[[1]][2] # get second text part 12 | txt=strsplit(txt,"EOF") # split text into 2 parts 13 | txt=txt[[1]][1] # get first text part 14 | # save data into a simple .csv file, sep=" ": 15 | cat(txt,file="qa194.csv") 16 | # read the TSP format into Data 17 | # (first row is empty, thus header=TRUE) 18 | # get city Cartesian coordinates 19 | 20 | Data=read.table("qa194.csv",sep=" ") 21 | Data=Data[,3:2] # longitude and latitude 22 | names(Data)=c("x","y") # x and y labels 23 | N=nrow(Data) # number of cities 24 | 25 | # distance between two cities (EUC_2D-norm) 26 | # Eulidean distance rounded to whole number 27 | D=dist(Data,upper=TRUE) 28 | D[1:length(D)]=round(D[1:length(D)]) 29 | # create TSP object from D: 30 | TD=TSP(D) 31 | 32 | set.seed(12345) # for replicability 33 | cat("2-opt run:\n") 34 | PTM=proc.time() # start clock 35 | R1=solve_TSP(TD,method="2-opt") 36 | sec=(proc.time()-PTM)[3] # get seconds elapsed 37 | print(R1) # show optimum 38 | cat("time elapsed:",sec,"\n") 39 | 40 | MAXIT=100000 41 | Methods=c("SANN","EA","LEA") # comparison of 3 methods 42 | RES=matrix(nrow=MAXIT,ncol=length(Methods)) 43 | MD=as.matrix(D) 44 | 45 | # overall distance of a tour (evaluation function): 46 | tour=function(s) 47 | { # compute tour length: 48 | EV<<-EV+1 # increase evaluations 49 | s=c(s,s[1]) # start city is also end city 50 | res=0 51 | for(i in 2:length(s)) res=res+MD[s[i],s[i-1]] 52 | # store memory with best values: 53 | if(resN) res=res-N 64 | return(res) 65 | } 66 | 67 | # local improvement and evaluation: 68 | # first tries to improve a solution with a 69 | # local search that uses domain knowledge (MD) 70 | # returns best solution and evaluation value 71 | local_imp_tour=function(s,p=NA) 72 | { # local search 73 | N=length(s); ALL=1:N 74 | if(is.na(p)) p=sample(ALL,1) # select random position 75 | I=setdiff(ALL,p) 76 | 77 | # current distance: p to neighbors 78 | pprev=mindex(p,-1,N=N); pnext=mindex(p,1,N=N) 79 | dpcur=MD[s[pprev],s[p]]+MD[s[p],s[pnext]] 80 | # new distance if p is remove to another position: 81 | dpnew=MD[s[pprev],s[pnext]] 82 | 83 | # search for best insertion position for p: 84 | ibest=0;best=-Inf 85 | for(i in I) # extra cycle that increases computation 86 | { 87 | inext=mindex(i,1,N=N);iprev=mindex(i,-1,N=N) 88 | if(inext==p) inext=pnext 89 | if(iprev==p) iprev=pprev 90 | # dinew: new distance p to neighbors if p inserted: 91 | # current i distance without p: 92 | if(i0 && dif>best) # improved solution 103 | { 104 | best=dif 105 | ibest=i 106 | } 107 | } 108 | 109 | if(ibest>0) # insert p in i 110 | s=insertion(s,p=p,i=ibest) 111 | return(list(eval=tour(s),solution=s)) 112 | } 113 | 114 | # SANN: 115 | cat("SANN run:\n") 116 | set.seed(12345) # for replicability 117 | s=sample(1:N,N) # initial solution 118 | EV=0; BEST=Inf; F=rep(NA,MAXIT) # reset these vars. 119 | C=list(maxit=MAXIT,temp=2000,trace=TRUE,REPORT=MAXIT) 120 | PTM=proc.time() # start clock 121 | SANN=optim(s,fn=tour,gr=insertion,method="SANN",control=C) 122 | sec=(proc.time()-PTM)[3] # get seconds elapsed 123 | cat("time elapsed:",sec,"\n") 124 | RES[,1]=F 125 | 126 | # EA: 127 | cat("EA run:\n") 128 | set.seed(12345) # for replicability 129 | EV=0; BEST=Inf; F=rep(NA,MAXIT) # reset these vars. 130 | pSize=30;iters=ceiling((MAXIT-pSize)/(pSize-1)) 131 | PTM=proc.time() # start clock 132 | OEA=oea(size=N,popSize=pSize,iters=iters,evalFunc=tour,crossfunc=ox,mutfunc=insertion,REPORT=iters,elitism=1) 133 | sec=(proc.time()-PTM)[3] # get seconds elapsed 134 | cat("time elapsed:",sec,"\n") 135 | RES[,2]=F 136 | 137 | # Lamarckian EA (LEA): 138 | cat("LEA run:\n") 139 | set.seed(12345) # for replicability 140 | EV=0; BEST=Inf; F=rep(NA,MAXIT) # reset these vars. 141 | pSize=30;iters=ceiling((MAXIT-pSize)/(pSize-1)) 142 | PTM=proc.time() # start clock 143 | LEA=oea(size=N,popSize=pSize,iters=iters,evalFunc=local_imp_tour,crossfunc=ox,mutfunc=insertion,REPORT=iters,elitism=1) 144 | sec=(proc.time()-PTM)[3] # get seconds elapsed 145 | cat("time elapsed:",sec,"\n") 146 | RES[,3]=F 147 | 148 | # create PDF with comparison: 149 | pdf("qa194-opt.pdf",paper="special") 150 | par(mar=c(4.0,4.0,0.1,0.1)) 151 | X=seq(1,MAXIT,length.out=200) 152 | ylim=c(min(RES)-50,max(RES)) 153 | plot(X,RES[X,1],ylim=ylim,type="l",lty=3,lwd=2,xlab="evaluations",ylab="tour distance") 154 | lines(X,RES[X,2],type="l",lty=2,lwd=2) 155 | lines(X,RES[X,3],type="l",lty=1,lwd=2) 156 | legend("topright",Methods,lwd=2,lty=3:1) 157 | dev.off() 158 | 159 | # create 3 PDF files with best tours: 160 | pdf("qa194-2-opt.pdf",paper="special") 161 | par(mar=c(0.0,0.0,0.0,0.0)) 162 | plot(Data[c(R1[1:N],R1[1]),],type="l",xaxt="n",yaxt="n") 163 | dev.off() 164 | pdf("qa194-ea.pdf",paper="special") 165 | par(mar=c(0.0,0.0,0.0,0.0)) 166 | b=OEA$population[which.min(OEA$evaluations),] 167 | plot(Data[c(b,b[1]),],type="l",xaxt="n",yaxt="n") 168 | dev.off() 169 | pdf("qa194-lea.pdf",paper="special") 170 | par(mar=c(0.0,0.0,0.0,0.0)) 171 | b=LEA$population[which.min(LEA$evaluations),] 172 | plot(Data[c(b,b[1]),],type="l",xaxt="n",yaxt="n") 173 | dev.off() 174 | -------------------------------------------------------------------------------- /Chapter7/tsp2.R: -------------------------------------------------------------------------------- 1 | ### tsp2.R file ### 2 | # this file assumes that tsp.R has already been executed 3 | 4 | library(rgeos) # get gArea function 5 | 6 | poly=function(data) 7 | { poly="";sep=", " 8 | for(i in 1:nrow(data)) 9 | { if(i==nrow(data)) sep="" 10 | poly=paste(poly,paste(data[i,],collapse=" "),sep,sep="") 11 | } 12 | poly=paste("POLYGON((",poly,"))",collapse="") 13 | poly=readWKT(poly) # WKT format to polygon 14 | } 15 | 16 | # new evaluation function: area of polygon 17 | area=function(s) return( gArea(poly(Data[c(s,s[1]),])) ) 18 | 19 | cat("area of 2-opt TSP tour:",area(R1),"\n") 20 | 21 | # plot area of 2-opt: 22 | pdf("qa-2opt-area.pdf",paper="special") 23 | par(mar=c(0.0,0.0,0.0,0.0)) 24 | PR1=poly(Data[c(R1,R1[1]),]) 25 | plot(PR1,col="gray") 26 | dev.off() 27 | 28 | # EA: 29 | cat("EA run for TSP area:\n") 30 | set.seed(12345) # for replicability 31 | pSize=30;iters=20 32 | PTM=proc.time() # start clock 33 | OEA=oea(size=N,popSize=pSize,iters=iters,evalFunc=area,crossfunc=ox,mutfunc=insertion,REPORT=iters,elitism=1) 34 | sec=(proc.time()-PTM)[3] # get seconds elapsed 35 | bi=which.min(OEA$evaluations) 36 | b=OEA$population[which.min(OEA$evaluations),] 37 | cat("best fitness:",OEA$evaluations[1],"time elapsed:",sec,"\n") 38 | 39 | # plot area of EA best solution: 40 | pdf("qa-ea-area.pdf",paper="special") 41 | par(mar=c(0.0,0.0,0.0,0.0)) 42 | PEA=poly(Data[c(b,b[1]),]) 43 | plot(PEA,col="gray") 44 | lines(Data[c(b,b[1]),],lwd=2) 45 | dev.off() 46 | -------------------------------------------------------------------------------- /Chapter7/wine-quality.R: -------------------------------------------------------------------------------- 1 | ### wine-quality.R file ### 2 | 3 | library(rminer) # load rminer package 4 | library(kernlab) # load svm functions used by rminer 5 | library(mco) # load mco package 6 | 7 | # load wine quality dataset directly from UCI repository: 8 | file="http://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-white.csv" 9 | d=read.table(file=file,sep=";",header=TRUE) 10 | 11 | # convert the output variable into 3 classes of wine: 12 | # "poor_or_average" <- 3,4,5 or 6; 13 | # "good_or_excellent" <- 7, 8 or 9 14 | d$quality=cut(d$quality,c(1,6,10), 15 | c("poor_or_average","good_or_excellent")) 16 | output=ncol(d) # output target index (last column) 17 | maxinputs=output-1 # number of maximum inputs 18 | 19 | # to speed up the demonstration, select a smaller sample of data: 20 | n=nrow(d) # total number of samples 21 | ns=round(n*0.25) # select a quarter of the samples 22 | set.seed(12345) # for replicability 23 | ALL=sample(1:n,ns) # contains 25% of the index samples 24 | # show a summary of the wine quality dataset (25%): 25 | print(summary(d[ALL,])) 26 | cat("output class distribuition (25% samples):\n") 27 | print(table(d[ALL,]$quality)) # show distribution of classes 28 | 29 | # holdout split: 30 | # select training data (for fitting the model), 70%; and 31 | # test data (for estimating generalization capabilities), 30%. 32 | H=holdout(d[ALL,]$quality,ratio=0.7) 33 | cat("nr. training samples:",length(H$tr),"\n") 34 | cat("nr. test samples:",length(H$ts),"\n") 35 | 36 | # evaluation function: 37 | # x is in the form c(Gamma,C,b1,b2,...,b11) 38 | eval=function(x) 39 | { n=length(x) 40 | gamma=2^x[1] 41 | C=2^x[2] 42 | features=round(x[3:n]) 43 | inputs=which(features==1) 44 | attributes=c(inputs,output) 45 | # divert console: 46 | # sink is used to avoid kernlab ksvm messages in a few cases 47 | sink(file=textConnection("rval","w",local = TRUE)) 48 | M=mining(quality~.,d[H$tr,attributes],method=c("kfold",3),model="svm",search=gamma,mpar=c(C,NA)) 49 | sink(NULL) # restores console 50 | # AUC for the internal 3-fold cross-validation: 51 | auc=as.numeric(mmetric(M,metric="AUC")) 52 | auc1=1-auc # transform auc maximization into minimization goal 53 | return(c(auc1,length(inputs))) 54 | } 55 | 56 | # NSGAII multi-objective optimization: 57 | cat("NSGAII optimization:\n") 58 | m=2 # two objectives: AUC and number of features 59 | lower=c(-15,-5,rep(0,maxinputs)) 60 | upper=c(3,15,rep(1,maxinputs)) 61 | PTM=proc.time() # start clock 62 | G=nsga2(fn=eval,idim=length(lower),odim=m,lower.bounds=lower,upper.bounds=upper,popsize=12,generations=10) 63 | sec=(proc.time()-PTM)[3] # get seconds elapsed 64 | cat("time elapsed:",sec,"\n") 65 | 66 | # show the Pareto front: 67 | I=which(G$pareto.optimal) 68 | for(i in I) 69 | { x=G$par[i,] 70 | n=length(x) 71 | gamma=2^x[1] 72 | C=2^x[2] 73 | features=round(x[3:n]) 74 | inputs=which(features==1) 75 | cat("gamma:",gamma,"C:",C,"features:",inputs,"; f=(", 76 | 1-G$value[i,1],G$value[i,2],")\n",sep=" ") 77 | } 78 | 79 | # create PDF showing the Pareto front: 80 | pdf(file="nsga-wine.pdf",paper="special",height=5,width=5) 81 | par(mar=c(4.0,4.0,0.1,0.1)) 82 | SI=sort.int(G$value[I,1],index.return=TRUE) 83 | plot(1-G$value[SI$ix,1],G$value[SI$ix,2],xlab="AUC",ylab="nr. features",type="b",lwd=2) 84 | dev.off() 85 | 86 | # selection of the SVM model with 4 inputs: 87 | x=G$par[I[7],] 88 | gamma=2^x[1] 89 | C=2^x[2] 90 | features=round(x[3:n]) 91 | inputs=which(features==1) 92 | attributes=c(inputs,output) 93 | # fit a SVM with the optimized parameters: 94 | cat("fit SVM with nr features:",length(inputs),"nr samples:",length(H$tr),"gamma:",gamma,"C:",C,"\n") 95 | cat("inputs:",names(d)[inputs],"\n") 96 | M=fit(quality~.,d[H$tr,attributes],model="svm", 97 | search=gamma,mpar=c(C,NA)) 98 | # get SVM predictions for unseen data: 99 | P=predict(M,d[H$ts,attributes]) 100 | # create PDF showing the ROC curve for unseen data: 101 | auc=mmetric(d[H$ts,]$quality,P,metric="AUC") 102 | main=paste("ROC curve for test data", 103 | " (AUC=",round(auc,digits=2),")",sep="") 104 | mgraph(d[H$ts,]$quality,P,graph="ROC",PDF="roc-wine",main=main,baseline=TRUE,Grid=10,leg="SVM") 105 | --------------------------------------------------------------------------------