Learning Genetic Algorithms

A teacher of mine tasked me with the challenge of building a genetic algorithm to solve diophantine equations. Before I jump into it, I will first attempt to build a simple genetic algorithm which just evolves in a very stupid manner. I am using a certain tutorial¹ for that.

The goal here is to have a minimal environment in which 32-bit numbers keep evolving, until they reach twenty 1's on their binary composition.

This GA is built using Common Lisp, due to my distaste for Java. If you're allergic to parenthesis, you've been warned.

Population is stored in a list. Unfortunately, this means that checking if a chromosome is in the list is O(n) speed at worst-case scenario (which is also a recurrent thing). I'll leave optimization heuristics for later, though.

(defparameter *population* nil)
(defparameter *fittest* nil)
(defparameter *max-fitness* 20)
(defparameter *rnd-state* (make-random-state))

Each individual on *population* is a different chromosome. The genes themselves will be the bits of each number. The two numbers of large fitness are stored in *fittest*. *max-fitness* tells us the least number of 1's we're expecting. And then, we have an initial *rnd-state* for randomization purposes.

Our fitness is calculated by the amount of 1's in the binary representation of our number. The more the amount, the better.

We define two functions: one is a predicate which, given the index of a bit, returns t if the bit is set to 1. The other one loops through every possible bit and counts how many of them are 1's.

(defun bit-set-p (bitmask bit-index)
  (declare ((unsigned-byte 32) bitmask)
           ((unsigned-byte 8) bit-index))
  (if (<= bit-index 31)
      (not (= (logand bitmask (ash 1 bit-index)) 0))
      nil))

(defun calc-fitness (chromosome)
  (loop for x below 32
     when (bit-set-p chromosome x)
     sum 1))

We also add a convenient function for printing the chromosome with its fitness.

(defun print-chromosome-with-fitness (chrm)
  (format t "~a => ~a~&"
          (format-chromosome chrm)
          (calc-fitness chrm)))

The selection phase is where the two fittest individuals are selected to pass on their genes to the next generation. This phase is automagically done on the with-distinct-chromosome macro.

The crossover process produces two new chromosomes. We generate a new individual by making the parents exchange their least significant bits. Each new value is, then, added to the population, and the selection phase takes place.

(defun breed (parent1 parent2)
  (declare ((unsigned-byte 32) parent1 parent2))
  (labels ((swap-bit (n)
             (let ((bit-p1 (bit-set-p parent1 n))
                   (bit-p2 (bit-set-p parent2 n)))
               (when (not (eq bit-p1 bit-p2))
                 (setf parent1 (logxor parent1 (ash 1 n))
                       parent2 (logxor parent2 (ash 1 n)))))))
    (dotimes (i 16)
      (swap-bit i)))
  (values parent1 parent2))

We also define a function to ensure our population never surpasses its fixed size. If it does, then the individuals of least fitness are removed.

(defun limit-population (max-num)
  (let* ((pop-len (length *population*))
         (exceed (- pop-len max-num)))
    (when (> exceed 0)
      (let ((pop-fitness (mapcar #'calc-fitness *population*)))
        (labels ((remove-minimum ()
                   (let ((min-index
                          (loop for i below pop-len
                             for elt in pop-fitness
                             with min = (cons 32 nil)
                             when (< elt (car min))
                             do (setf min (cons elt i))
                             finally (return (cdr min)))))
                     (when min-index
                       (setf *population*
                             (loop for elt in *population*
                                for i from 0
                                unless (= i min-index) collect elt)
                             pop-len (1- pop-len))))))
          (dotimes (i exceed)
            (remove-minimum)))))))

To ensure population diversity and remove the chances of early convergence, we mutate some genes at a low rate. By picking a maximum of 16 genes, regardless of significancy, at random, it is possible to roll the dice again (with little probability): should the odds be on favor, the specified gene will suffer a "flip".

(defun mutate (chromosome)
  (declare ((unsigned-byte 32) chromosome))
  (let* ((num-mutations (random 16 *rnd-state*))
         (mutating-indexes (remove-duplicates
                            (loop for i below num-mutations
                                collect (random 32 *rnd-state*)))))
    (labels ((attempt-mutation-at (n)
               ;; Throw d20 and expect < 8
               (when (< (random 20 *rnd-state*) 7)
                 (setf chromosome (logxor chromosome (ash 1 n))))))
      (mapc #'attempt-mutation-at mutating-indexes)))
  chromosome)

Now we define our actual crossover function. The crossover function takes into consideration both the breeding process and the mutation.

(defun crossover ()
  (multiple-value-bind (offspring1 offspring2)
      (apply #'breed *fittest*)
    (with-distinct-chromosome (mutate offspring1))
    (with-distinct-chromosome (mutate offspring2))))

We need a strategy to check if our population converged. For a genetic algorithm, a converged population usually means that we've reached a max fitness. Therefore, we just need to check if our fittest individual has a fitness greater or equal than the specified max fitness.

(defun population-converged-p ()
  (>= (calc-fitness (car *fittest*))
      *max-fitness*))

Now we can create a proper loop which will execute the steps of our algorithm until the population converges.

(defun debriefing ()
  (princ "Population converged.") (terpri)
  (format t "Best fitness: ~a~%~%" (calc-fitness (car *fittest*)))
  (princ "Final population:") (terpri)
  (mapc #'print-chromosome-with-fitness *population*)
  (terpri))

(defun run-genetic-algorithm ()
  (initialize-population)
   (loop until (population-converged-p)
      for i from 0
      do (format t "Generation: ~a~%Fittest:~%" i)
        (mapc #'print-chromosome *fittest*)
        (terpri)
        (crossover)
        (limit-population 10))
  (debriefing))

With everything all sorted and done, we can test our algorithm at once. Here's one possible output when running the function run-genetic-algorithm:

Generation: 0
Fittest:
00010010010011110001000000000000
01011010010100010000000000001000

Generation: 1
Fittest:
00010010010011110001000000000000
01011010010100010000000000001000

Generation: 2
Fittest:
01011110100100010001000101000000
00010010010011110001000000000000

Generation: 3
Fittest:
00011010011011110001000101000000
01011110100100010001000101000000

Generation: 4
Fittest:
00111010010111110000001101000000
00011010011011110001000101000000

Generation: 5
Fittest:
00111010010111110000001101000000
00011010011011110001000101000000

Generation: 6
Fittest:
00111010010111110000001101000000
00111010010111110001000101000000

Generation: 7
Fittest:
10111010010111110001100101000000
00111010010111111000001101100000

Generation: 8
Fittest:
10111010010111110001100101000000
00111010010111111000001101100000

Generation: 9
Fittest:
10111010010111110001100101000000
00111010010111111000001101100000

Generation: 10
Fittest:
10111010010111110001100101000000
00111010010111111000001101100000

Generation: 11
Fittest:
10110010010111111010101101101001
10111010010111110001100101000000

Population converged.
Best fitness: 22

Final population:
10111110010111111010101101101011 => 22
10110010010111110001100101000000 => 14
10110010010111111010101101101001 => 19
00011010010111110001000101000100 => 13
00111010010111110100001001100000 => 14
00111010010111111000001101100000 => 15
10111010010111110001100101000000 => 15
10011000011011110000001101001000 => 13
00111010010111110001000101000000 => 13
00111010010111110000001101000000 => 13