An even better one

Here's the new and improved weasel program. It removes a major inefficiency of the version I posted yesterday, in that in any given generation only one string was reproducing. Since in any generation (except of course the last two of them), the content of the fittest string need not be unique, it could speed up evolution a lot if we allow all maximum fitness strings to reproduce. The program below does just that. Now with the number of offspring = 100 and a mutation rate of 5%, it never takes more than 30 generations to achieve convergence. The output of R code below displays all maximum fitness strings from each generation.

# A Version of Dawkins' Weasel in R
# (c) 2011 Przemyslaw Nowaczyk
 
Weasel <- function(phrase,num.copies,mutation.rate) {
  Score  <- function(x,y) {sum(x==y)}
  Output <- function(x,y,z) {cat(x,y,z,"\n")}
  alphabet <- toupper(c(letters," "))
  split.phrase <- unlist(strsplit(phrase,""))
  new.phrase   <- as.matrix(sample(alphabet,size=nchar(phrase),replace=TRUE))
  max.fitness  <- Score(new.phrase,split.phrase)
  generation   <- 0
  while (max.fitness < length(split.phrase)) {
    offspring   <- new.phrase[,rep(1:ncol(new.phrase),num.copies)]
    mutant.flag <- mat.or.vec(nrow(offspring),ncol(offspring))
    mutant.flag <- sample(c(0,1),prob=c((1-mutation.rate),mutation.rate),
                          replace=TRUE,size=(nrow(offspring)*ncol(offspring)))
    offspring[mutant.flag==1] <- sample(alphabet,size=sum(mutant.flag),
                                        replace=TRUE)
    fitness <- apply(offspring,2,Score,y=split.phrase)
    fit.id  <- which(fitness==max(fitness))
    new.phrase  <- as.matrix(offspring[,fit.id[1:length(fit.id)]])
    max.fitness <- max(fitness)
    generation  <- generation + 1
    apply(new.phrase,2,Output,y=generation,
     z=round((max.fitness/nchar(phrase))*100,digits=2))
  }
}
 
# sample run with timing
system.time(Weasel(phrase="METHINKS IT IS LIKE A WEASEL",num.copies=10,
                   mutation.rate=0.01))

Created by Pretty R at inside-R.org