I’ve been learning a lot of Scheme programming recently, and while learning is great, it’s nothing if you can’t cut your teeth on a project of your own every once in a while. I needed a project. It had to be something not dictated by SICP, something fairly challenging, and also something of decent size. When I first tried reading SICP in college, I’d tried implementing genetic algorithms in it and failed horribly. To see if I’d made any progress I decided to try implementing them again.

It’s All In The Genomes

The first thing I had to do was decide on a implementation for the genome. I decided to do the simplest possible genetic algorithm – function maximization. The genome then naturally suggested itself as a list of integers, 1 or 0. So I began by writing a series of functions for generating and manipulating these lists as follows:

(define (random-bit) (random 2))

(define (make-random-genome num-bits)
  (map (lambda (x) (random-bit)) (iota num-bits 1)))

(define (make-probabilistic-bit-flipper num-bits)
  (define (bit-flipper bit)
    (let ((bit-array (append '(1) (make-list (- num-bits 1) 0))))
      (if (= 1 (list-ref bit-array (random num-bits)))
          (if (= bit 0) 1 0)
          bit)))
  bit-flipper)

(define (mutate genome)
  (map (make-probabilistic-bit-flipper (length genome)) genome))

(define (crossover g1 g2)
  (let ((crossover-point (random (length g1))))
    (cons (append (list-head g1 crossover-point)
                  (list-tail g2 crossover-point))
          (append (list-head g2 crossover-point)
                  (list-tail g1 crossover-point)))))

The method make-probabilistic-bit-flipper is likely the only one that could use some explanation. The code is based on this stack overflow answer which suggests a simple method for selecting a value with a given probability. In make-probabilistic-bit-flipper, if you have a genome of 10 bits, you want the probability that any single bit gets flipped in mutation to be 1/10. To do this you make a list with 9 0’s and a single 1. You then select a position at random from the list. If the value there is 1, then you flip the bit. The 1 value will be selected 1/10 times.

Population Control

Now that I could generate random genomes it was time to create entire populations of individual genomes. The first parts were the easiest, generating a population and gathering statistics over its members:

(define (make-random-population population-size make-member-func)
  (map (lambda (x) (make-member-func)) (iota population-size 1)))

(define (get-member-fitness population fitness-func)
  (map fitness-func population))

(define (get-average-fitness population fitness-func)
  (/ (reduce + 0 (get-member-fitness population fitness-func))
     (exact->inexact (length population))))

After this it was time to actual think about the implementation of the evolution step. For this I knew I’d need a selection mechanism as well as a means of grabbing the genome of the fittest member from a list of genomes:

(define (random-shuffle lst)
  (sort lst (lambda (x y) (equal? 0 (random 2)))))

(define (make-random-bit-mask size num-ones)
  (if (< size num-ones)
      (error "Invalid size -- MAKE-RANDOM-BIT-MASK" size num-ones)
      (random-shuffle (append (make-list num-ones 1)
                              (make-list (- size num-ones) 0)))))

(define (select-for-tournament population tournament-size)
  (map car
     (filter (lambda (x) (= (cdr x) 1))
             (map cons
                population
                (make-random-bit-mask (length population)
                                      tournament-size)))))


(define (select-fittest population fitness-func num-to-select)
  (list-head
   (sort population
         (lambda (x y) (> (fitness-func x) (fitness-func y))))
   num-to-select))

To implement tournament selection I decided the easiest method, that would also allow for the use of higher-order functions, was to generate a random list with all zeros except for a given number of 1’s. This bit-mask would then be randomized and applied across the population to select the given number of individuals. I then also needed a method to select the fittest n members from the population, as this would be useful both in tournament selection and in gather the best seen members from the various generations. With all these pieces in place I could create a method that would produce the next generation from a given input generation:

(define (next-generation population fitness-func)
  (define (produce-next-generation-member)
    (if (= 1 (random 2))
        (let ((tournament-members (select-for-tournament population 3)))
          ((if (= 1 (random 2)) car cdr)
           (apply crossover
                  (select-fittest tournament-members fitness-func 2))))
        (mutate (car (select-for-tournament population 1)))))
  (map (lambda (x) (produce-next-generation-member))
     (iota (length population) 1)))

While this method works, I’m a little unhappy that I have to throw away a member from the crossover rounds. I just simply couldn’t figure out a way to do this that would keep the method nice and simple, so I haven’t yet.

Assembling all of these pieces together I could write a simple method to optimize a bit-array:

(define (bits->int genome)
  (reduce + 0
   (map (lambda (x y) (* x (expt 2 y)))
      genome
      (reverse (map (lambda (x) (- x 1)) (iota (length genome) 1))))))

(define population
  (make-random-population 10 (lambda () (make-random-genome 10))))

(next-generation population bits->int)

Conclusion

I was actually able to do it, and the result is pretty simple! Overall I’m happy with this genetic algorithm implementation, though there is plenty of room for improvement. Next steps, who knows, definitely applying it to more complicated problems, but perhaps also extending it to genetic programming. Hope you’ve enjoyed this! You can find the complete implementation below:

• Gist Of Complete Implementation