Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- target<-utf8ToInt("Hello World")
- #####Random Mating with Mutation. No selective breeding at all.
- #The generation array stores each generation (duh)
- generation<- array(0,c(100,11,100))
- generation[,,1]<- t(replicate(100, round(runif(11,0,255))))
- #Two for loops is generally an R no-no, but since the computation is explicitly serial, I wasn't sure how to get around it
- #However I was able to put most of the random number generation in the outer loop and use indices to pick and choose which
- #ones I wanted.
- for (n in 2:100) {
- #We randomly select parents from the preceding generation. r.split tells us how the traits will be passed on to
- #offspring. sel.mutate picks a single element in the child for mutation
- parent.1<- sample(nrow(generation[,,n-1]),nrow(generation[,,n-1])/2,replace=FALSE)
- parent.2<- setdiff(1:100,parent.1)
- parents<- c(parent.1,parent.2)
- r.split<- round(runif(100,min=2,max=10))
- sel.mutate<- round(runif(100,min=1,max=11))
- #The inner loop operates over the columns of each of n generations. We pair parents from the preceding generation and get
- #child traits in one line.
- for (j in 1:100) {
- generation[j,,n]<- c(generation[parents[j],1:r.split[j],n-1],generation[parents[101-j],(r.split[j]+1):11,n-1])
- #The boundaries for mutation are set because we are using integers which represent UTF-8 characters and I want to stick between
- #0-255. I'm sure there is a more elegant way to do this.
- if (generation[j,sel.mutate[j],n] <= 250 & generation[j,sel.mutate[j],n] >= 5)
- generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=5))
- else if (generation[j,sel.mutate[j],n] < 5)
- generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=0,max=5))
- else
- generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=0))
- }
- }
- ####Tournament style mating. Sort of.
- #Same mutation and chromosome swap as the random mating.
- #Actually doesn't converge because we don't pull people out of the pool!
- #Will take a little bit of time to run what with the really inefficient/ugly code
- generation<- array(0,c(100,11,200))
- generation[,,1]<- t(replicate(100, round(runif(11,0,255))))
- for (n in 2:200) {
- tour.parents<-matrix(0,nrow=50,ncol=2)
- past.parent<-numeric(0)
- second.pot.parent<- numeric(0)
- #This loop chooses parents. We select 2 at random from the pool which has not already been selected.
- #If the fitness of one is higher, we choose that as the first parent, then choose the second one in the same fashion
- #Repeat 50 times and we have our 50 pairs.
- for (j in 1:50) {
- pot.parent<-sample(setdiff(1:100,past.parent),2,replace=FALSE)
- if (sum(abs(target-generation[pot.parent[1],,n-1])) <= sum(abs(target-generation[pot.parent[2],,n-1]))) {
- tour.parents[j,1]<-pot.parent[1]
- second.draw<- sample(setdiff(1:100,c(pot.parent[2],past.parent)),1,replace=FALSE)
- second.pot.parent<- pot.parent[2]
- }
- else {
- tour.parents[j,1]<-pot.parent[2]
- second.draw<- sample(setdiff(1:100,c(pot.parent[1],past.parent)),1,replace=FALSE)
- second.pot.parent<- pot.parent[1]
- }
- if (sum(abs(target-generation[second.pot.parent,,n-1])) <= sum(abs(target-generation[second.draw,,n-1]))) {
- tour.parents[j,2]<-second.pot.parent
- }
- else {
- tour.parents[j,2]<-second.draw
- }
- past.parent<- c(past.parent,tour.parents[j,])
- pot.parent<-numeric(0)
- second.pot.parent<-numeric(0)
- }
- #Because we have 50 parents and want 100 members of the next generation, each has two kids, with the opposite chromosome split.
- r.split<- round(runif(100,min=2,max=10))
- for (j in 1:50) {
- generation[j,,n]<- c(generation[tour.parents[j,1],1:r.split[j],n-1],generation[tour.parents[j,2],(r.split[j]+1):11,n-1])
- generation[101-j,,n]<- c(generation[tour.parents[j,2],1:r.split[j],n-1],generation[tour.parents[j,1],(r.split[j]+1):11,n-1])
- }
- #Same mutation as the random mating.
- sel.mutate<- round(runif(100,min=1,max=11))
- for (j in 1:100) {
- if (generation[j,sel.mutate[j],n] <= 250 & generation[j,sel.mutate[j],n] >= 5)
- generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=5))
- else if (generation[j,sel.mutate[j],n] < 5)
- generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=0,max=5))
- else
- generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=0))
- }
- }
- ###Some removal of the bottom 10% of solutions. Not effective (as the graph shows)
- dec.quant<- seq(0, 1, 0.1)
- generation<- array(0,c(100,11,500))
- generation[,,1]<- t(replicate(100, round(runif(11,0,255))))
- for (n in 2:dim(generation)[3]) {
- tour.parents<-matrix(0,nrow=50,ncol=2)
- past.parent<- rep.parents<- rm.parents <- numeric(0)
- second.pot.parent<- numeric(0)
- r.split<- round(runif(100,min=2,max=10))
- for (j in 1:50) {
- pot.parent<-sample(setdiff(1:100,past.parent),2,replace=FALSE)
- if (sum(abs(target-generation[pot.parent[1],,n-1])) <= sum(abs(target-generation[pot.parent[2],,n-1]))) {
- tour.parents[j,1]<-pot.parent[1]
- second.draw<- sample(setdiff(1:100,c(pot.parent[2],past.parent)),1,replace=FALSE)
- second.pot.parent<- pot.parent[2]
- }
- else {
- tour.parents[j,1]<-pot.parent[2]
- second.draw<- sample(setdiff(1:100,c(pot.parent[1],past.parent)),1,replace=FALSE)
- second.pot.parent<- pot.parent[1]
- }
- if (sum(abs(target-generation[second.pot.parent,,n-1])) <= sum(abs(target-generation[second.draw,,n-1]))) {
- tour.parents[j,2]<-second.pot.parent
- }
- else {
- tour.parents[j,2]<-second.draw
- }
- generation[j,,n]<- c(generation[tour.parents[j,1],1:r.split[j],n-1],generation[tour.parents[j,2],(r.split[j]+1):11,n-1])
- generation[101-j,,n]<- c(generation[tour.parents[j,2],1:r.split[j],n-1],generation[tour.parents[j,1],(r.split[j]+1):11,n-1])
- past.parent<- c(past.parent,tour.parents[j,])
- pot.parent<- second.pot.parent<- numeric(0)
- }
- sel.mutate<- round(runif(100,min=1,max=11))
- for (j in 1:100) {
- if (generation[j,sel.mutate[j],n] <= 250 & generation[j,sel.mutate[j],n] >= 5)
- generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=5))
- else if (generation[j,sel.mutate[j],n] < 5)
- generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=0,max=5))
- else
- generation[j,sel.mutate[j],n]<- generation[j,sel.mutate[j],n] + round(runif(1,min=-5,max=0))
- }
- rm.parents<- which (rowSums(abs(target.mat-generation[,,n])) > quantile(rowSums(abs(target.mat-generation[,,n])),probs= dec.quant)[[10]])
- rep.parents<- sample(which (rowSums(abs(target.mat-generation[,,n-1])) < quantile(rowSums(abs(target.mat-generation[,,n-1])),probs= dec.quant)[[3]]),size=length(rm.parents))
- generation[rm.parents,,n]<- generation[rep.parents,,n-1]
- rep.parents<- rm.parents <- numeric(0)
- }
- ###Plotting the output. this plots the minimum. You could choose the average or whatever.
- no.select<-numeric(0)
- for (n in 1:dim(generation)[3]) {no.select[n]<- min(rowSums(abs(target-generation[,,n])))}
- plot(1:dim(generation)[3],no.select,type="l")
Add Comment
Please, Sign In to add comment