A bad hash at genetic optimization

Genetic hello world.R

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")