Finding solutions using genetic algorithms in F#

A genetic algorithm simulates the process of evolution in order to find an optimal solution to a problem.  This sort of algorithm can be used when there isn’t a single perfect answer, but software can be built to search for the best solution given the amount of time we’re willing to spend on it.

Here, we will solve a simple problem to introduce the structure of a genetic algorithm in F#.  We want the machine to find a path around an obstruction.  Say you have a grid and the starting point is the origin, and there is a line on the X-axis from (0,-2) to (0,+2) that the algorithm needs to find a way around.  Not an incredibly difficult problem, there are certainly many ways to solve it and may possible solutions, but I’ll use it to introduce the mechanics of solving such a problem.

First, a few definitions (types).  A “trait” is a characteristic, and a list of these characteristics makes up an “individual”, which might be a solution to our problem.  Given that our problem is to navigate a grid, our traits will be four operations – Forward, Up, Down, and Back.  For a genetic algorithm, you start with a pool of individuals, which we will refer to as a “population”.

type Trait =
    | Forward
    | Up
    | Down
    | Back
type Individual = Trait list
type Population = Individual list

A genetic algorithm will combine two (or sometimes more) individuals in one generation to create the next generation of individuals.  We’ll refer to those as “parents”.

type Parents = Individual * Individual

The general process is to take an initial population, evaluate each individual against some fitness function to rank each of them, then combine the best performers into a new population – a generation.  Repeat until an optimal solution is found amongst the individuals in a population.  Prevent stagnation between generations by adding mutation, which can “tweak” individuals a bit so each generation will differ from the previous at least a little bit.

To begin the search for a solution, we need to create some initial population of individuals.  Individuals can be generated completely at random (as we will here) or with some predefined logic.

let createIndividual (rng:Random) (size:int) : Individual =
    let rec buildList numLeftToAdd lst =
        match numLeftToAdd with
        | 0 -> lst
        | left -> 
            let nextRandom = 
                match rng.Next(4) with
                | 0 -> Forward
                | 1 -> Up
                | 2 -> Down
                | 3 -> Back
                | n -> failwithf "No operation mapped for %i" n
            nextRandom :: lst |> buildList (left - 1)
    buildList size List.empty

So what did that do?  It recursively builds a list, prepending a random trait to be beginning of it.  Next, we need a function to create a population of a given size.  This function should accept the population size and a function to create individuals for the population.

let createPopulation populationSize newIndividual : Population = 
    let rec buildPopulation numLeft population =
        match numLeft with
        | 0 -> population
        | n -> (newIndividual ()) :: population |> buildPopulation (n - 1)
    buildPopulation populationSize List.empty

Not a lot to this, as it’s delegating the hard work to the newIndividual function.  And now we need to run our simulation.  This would accept a candidate individual, run them through the simulation, and return the result for that candidate.  This can be represented a Result record that contains the final coordinate and the candidate, which we will need if this is one of the members of the population that is selected for the next generation.

type Coordinate = { X:int; Y:int }

type Result = { FinalPosition:Coordinate; Candidate:Individual }

let runSimulation initialPosition (candidate: Individual) =
    let newPosition coordinate operation =
        match operation with
        // First the case of moving forward but hitting the obstacle 
        | Forward when coordinate.X + 1 = 3 
            && coordinate.Y >= -2 
            && coordinate.Y <= 2 -> coordinate // goes nowhere
         // With no obstruction, go ahead and move forward
        | Forward -> { coordinate with X=(coordinate.X + 1) }
        // Also can't move backward and hit the obstacle
        | Back when coordinate.X - 1 = 3
            && coordinate.Y >= -2
            && coordinate.Y <= 2 -> coordinate // goes nowhere
        // Go back without obstruction
        | Back -> { coordinate with X=(coordinate.X - 1) }
        // Can always go up or down - the block is a line.
        | Up -> { coordinate with Y=(coordinate.Y + 1) }
        | Down -> { coordinate with Y=(coordinate.Y - 1) }
    /// Fold over each operation going from initial to final position
    let finalCoordinate = 
        candidate |> List.fold newPosition initialPosition
    { FinalPosition=finalCoordinate; Candidate=candidate }

Now we determine the fitness for a result.  The goal here is to move as far to the right as possible, so the position along the x-axis is effectively the “score” for an individual’s result.

type Fitness = { X_Position:int; Result:Result }

let fitness result =
    { X_Position=result.FinalPosition.X; Result=result }

A whole population can be evaluated by running the simulation and the evaluating the fitness of each individual. We can compose the runSimulation and fitness functions, and pass each member of the population through this composition to get the fitness of each.  Each member starts at the same initial position – the origin – (0,0).

let evaluateGeneration initialPosition (generation:Population) =
    |> (initialPosition |> runSimulation >> fitness)

After evaluating the population, we will want to create a new population for the next generation. This consists of selecting the best individuals, mutating some, and crossing them with each other in some way to result in a new population.

First, we can define a crossover function:

let crossover crossoverPoint (parents:Parents) =
    let parent1, parent2 = 
        parents |> fst,
        parents |> snd
        parent1 |> List.take crossoverPoint
        parent2 |> List.skip crossoverPoint
    ] |> List.concat
    : Individual

This will concatenate the first part of one individual with the second part of another list to create a new individual. This is one of the areas you may decide to try some different strategies to see what works best. You could interleave traits from the two individuals, you could combine traits from more than two, but the general point is that you need to build a new individual with building blocks from the parents. A little randomness is often good here as well. If you always crossover parents at the middle, then after a few generations they are always swapping the same traits back and the algorithm won’t evolve as well.

Next, we need mutation. Without some diversity, these same traits will always be selected as the best and never really get any better. By adding mutation, different individuals can be pushed to the top so they crossover with others, preventing stagnation and moving the population forward. The mutation below will create an entirely new individual in the population, although this is another place where different strategies should be attempted.

let mutation newIndividual (population:Population) =
    |> List.mapi (fun idx individual -> 
        if idx % 13 = 0 then // replace 13th member of the population
            newIndividual ()

If we just wanted to skip mutation altogether, we could have this sort of mutation function:

let noMutation (population: Population) = population

Armed with a crossover function to make an Individual from Parents and a mutation function to modify some elements of a population, we can take the results for one generation and apply the mutation and crossover to get the next generation.

We want the better part of the current population, and we will make our next generation by combining the best two with the better half of the population.

  1. Get better half + 2 for the parents
  2. Apply the mutation function to the better half
  3. Crossover the best two with the rest of the population to get a new population
let nextGeneration (mutation:Population -> Population) (crossover:Parents -> Individual) (generationWithResults:Fitness list) =
    let betterHalf : Population =
        |> List.sortByDescending (fun fitness -> fitness.X_Position)
        |> List.truncate (generationWithResults.Length / 2 + 2)
        |> (fun fitness -> // and get just best of the population

    // Apply some mutation before the crossover.
    betterHalf |> mutation
    |> function // take the first two and crossover with the rest.
    | first::second::rest ->
            rest |> (fun prevGen -> crossover (first, prevGen) )
            rest |> (fun prevGen -> crossover (second, prevGen) )
        ] |> List.concat
    | _ -> failwithf "Population is too small (%i) for another generation." betterHalf.Length

It’s important to note that the mutation should generally occur before the crossover. If it is applied afterwards, then you just have a few unusual candidates that will probably perform poorly and be eliminated before they ever crossover with others.

With initial generation, fitness, crossover, and mutation in place, let’s write put it together. We state our goal, make an evolve function that processes a generation and then continues until it finds an optimal solution, up to a maximum number of generations.

let main argv =
    /// Some randomness for generating individuals' traits.
    let rng = Random ()

    /// We'll have 25 moves to get around the obstacle and head to the right.
    let numberOfMoves = 25

    /// Start at the origin.
    let initialPosition = { X=0; Y=0 }

    /// make a function to create an individual
    let newIndividual () = createIndividual rng numberOfMoves

    /// define a function to mutate
    let mutate = mutation newIndividual

    /// Function that will evolve a population through generations
    let rec evolve max current population =
        let randomPoint = rng.Next(0, numberOfMoves)
        let crossoverAtPoint = crossover randomPoint 
        match current with
        | i when i = max -> ()
        | i -> 
            let results = population |> evaluateGeneration initialPosition
            let best = results |> List.sortByDescending (fun fitness -> fitness.X_Position) |> List.head
            printfn "gen %i results: %A" i best
            let nextGen = results |> nextGeneration mutate crossoverAtPoint
            nextGen |> evolve max (i + 1)

    let initialPopulationSize = 35
    /// make the initial candidates
    let initialPopulation = newIndividual |> createPopulation initialPopulationSize
    printfn "Initial candidates: %A" initialPopulation
    /// Run 1000 iterations starting with the initial population
    evolve 1000 0 initialPopulation

Running the application will generate a population and run it through generations to find an optimal solution. Here are a few sample generations:

gen 0 results: {X_Position = 3;
 Result =
  {FinalPosition = {X = 3;
                    Y = -8;};
   Candidate =
    [Back; Down; Back; Down; Forward; Forward; Up; Forward; Back; Back; Forward;
     Back; Down; Forward; Down; Down; Forward; Forward; Back; Down; Forward;
     Forward; Down; Down; Down];};}

Wow, kind of just wandering aimlessly, going backwards a bunch. But by the 4th generation, it figured out to go forward a lot more. Still hit that wall a few times, wasting moves.

gen 4 results: {X_Position = 7;
 Result =
  {FinalPosition = {X = 7;
                    Y = 2;};
   Candidate =
    [Forward; Forward; Back; Forward; Forward; Up; Forward; Up; Up; Up; Forward;
     Down; Forward; Up; Forward; Forward; Down; Forward; Up; Back; Down; Down;
     Down; Up; Forward];};}

It starts to look figure things out, going up or down early on, then going forward a lot.

gen 112 results: {X_Position = 13;
 Result =
  {FinalPosition = {X = 13;
                    Y = -8;};
   Candidate =
    [Down; Forward; Forward; Down; Down; Forward; Forward; Down; Up; Down; Back;
     Forward; Forward; Forward; Forward; Forward; Down; Forward; Down; Forward;
     Down; Down; Forward; Forward; Forward];};}

I let it go 1000 times. Probably not so necessary, but here’s where it ended up, heading down below the obstruction then mostly forward after that.

gen 999 results: {X_Position = 17;
 Result =
  {FinalPosition = {X = 17;
                    Y = -2;};
   Candidate =
    [Down; Forward; Down; Down; Forward; Forward; Forward; Up; Forward; Forward;
     Up; Forward; Up; Forward; Forward; Forward; Forward; Forward; Forward; Down;
     Forward; Forward; Forward; Down; Forward];};}
Not too complex, and we’ve evolved a set of data that meets our goal. Interestingly, we can change our obstruction or add more obstructions to our simulation and see the algorithm evolve differently.
A quick summary:
  1. Define the traits that make up an individual.
  2. Define functions to create individuals and an initial population
  3. Define a function to simulate what you want the individuals to attempt
  4. Define a fitness function to determine which individuals perform the best
  5. Define a crossover function and a mutation function to create better generations
  6. Evolve the individuals through generations until you achieve an optimal result.