# The Bee Colony in action

In our previous installments, we laid the groundwork of our Bee Colony Algorithm implementation. Today, it’s time to put the bees to work, searching for an acceptable solution to the Traveling Salesman problem.

We will approach the search as a Sequence: starting from an initial hive and solution, we will unfold it, updating the state of the hive and the current best solution at each step. Let’s start with the hive initialization. Starting from an initial route, we need to create a pre-defined number of each Bee type, and provide them with an initial destination:

let Initialize nScouts nActives nInactives cities (rng : Random) =
[
for i in 1 .. nScouts do
let solution = Evaluate(Shuffle rng cities)
yield Scout(solution)
for i in 1 .. nActives do
let solution = Evaluate(Shuffle rng cities)
yield Active(solution, 0)
for i in 1 .. nActives do
let solution = Evaluate(Shuffle rng cities)
yield Inactive(solution)
]


There is probably a more elegant way to do this, but this is good enough: we use a simple List comprehension to generate a list on the fly, yielding the appropriate number of each type of bees, and assigning them a shuffled version of the starting route.

Next, we need a function to update our hive, and the current best solution available:

let Update (hive, currentBest : Solution) rng =
let searchResult = List.map (fun b -> Search b rng) hive
let newSolutions = List.choose (fun e -> snd e) searchResult
let newBest = List.fold (fun best solution ->
if best.Cost < solution.Cost
then best
else solution) currentBest newSolutions
let inactives = CountInactives hive
let updatedHive = searchResult
|> List.map (fun b -> Waggle newSolutions (fst b) rng)
|> Activate rng inactives
(updatedHive, newBest)


The function takes 2 arguments: a Tuple of the current state of affairs (the hive and the best solution), and a random number generator. First, we use List.map, to apply the Search function we defined earlier to each bee, returning a new List of Tuples, containing each bee and an option containing the result of its search (a new solution, or None). We then extract the new solutions from that list, using List.choose to retrieve the second element of the Tuples when they are not None, and use a List.fold to find the new best solution from that list, if it is better than the current best solution. Finally, we update the Hive, by having each Bee perform its Waggle dance and share its new information via List.map, and applying the Activate function to promote some of the inactive bees to Active status – and return a Tuple of the updated hive and updated best solution.

We are now almost done – we can now define a Solve function, which will call Initialize to create an initial hive, and unfold an infinite Sequence of solutions:

let Solve scouts actives inactives route =
let rng = new Random()
let hive = Initialize scouts actives inactives route rng
let initialBest = List.map (fun b -> Solution b) hive
|> List.minBy (fun s -> s.Cost)
Seq.unfold (fun h -> Some(h, (Update h rng))) (hive, initialBest)


It’s now time to see this in action. Let’s add a file to our project, and create a small console application Program.fs. First, we need a good test case: let’s generate a list of cities named A to Z, located on a circle:

let RandomRoute radius points =
[
let rng = new Random()
let letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
for i in 0 .. (points - 1) do
let angle = Math.PI * 2.0 * (double)i / (double)points
let name = letters.[i];
yield {
Solver.City.Name = (string)name;
Solver.City.Y = Math.Sin(angle) * radius }
]


If our algorithm is working, it should return a list of cities sorted in alphabetical (or reverse-alphabetical) order.

Next, let’s create an entry point for our console application, and watch the bees at work:

[<EntryPoint>]
let main (args : string[]) =
printfn "Bee Hive colony at work!"

let stopwatch = new Stopwatch()
stopwatch.Start()

let rng = new Random()
let route = RandomRoute 100.0 26
let bestSolution = Solver.Evaluate route
printfn "Best possible cost: %f" bestSolution.Cost

let initialSolution = Solver.Evaluate (Solver.Shuffle rng route)
printfn "Initial cost: %f " initialSolution.Cost

let search = Solver.Solve 30 50 20 route
let solution = search |> Seq.nth 20000 |> snd

stopwatch.Stop()
printfn "Milliseconds: %d" stopwatch.ElapsedMilliseconds

printfn "Solution cost: %f" solution.Cost
solution.Route |> List.iter (fun c -> printf "%s " c.Name)

printfn ""
printfn "Press enter to close"
0


Running this produces the following: In about three minutes, starting from a path of length 3450, we found a solution of length 946, out of a possible best of 627. The list has long stretches of correctly reverse-sorted cities (it got D to R properly ordered), with a few misplaced cities. Not too bad!

Before going further, here is the complete code I wrote so far, in its current state. First, the Solver.fs file, which contains the algorithm logic:

module Solver
open System

let probaFalsePositive = 0.1 // proba to incorrectly pick a worse solution
let probaFalseNegative = 0.1 // proba to miss an improved solution
let tripsLimit = 100 // number of trips without improvements a bee can make
let probaConvince = 0.8 // proba to convince a bee to target a better solution

let SwapIndexPairs (rng : Random) list =
seq {
for i in (List.length list - 1) .. -1 .. 1 do
yield (i, rng.Next(i + 1)) }

let SwapIndexMap index (moveIndex, toIndex) =
if index = moveIndex then toIndex
elif index = toIndex then moveIndex
else index

let Swap indexPair list =
let length = List.length list
List.permute (fun index -> SwapIndexMap index indexPair) list

let Shuffle (rng : Random) list =
let length = List.length list
let indexPairs = SwapIndexPairs rng list
Seq.scan (fun currentList indexPair -> Swap indexPair currentList)
list indexPairs
|> Seq.nth (length - 1)

let SwapWithNextIndexMap index swapIndex length =
let flipWith = (swapIndex + 1) % length
SwapIndexMap index (swapIndex, flipWith)

let SwapWithNext swapIndex list =
let length = List.length list
List.permute (fun index -> SwapWithNextIndexMap index swapIndex length) list

let SwapRandomNeighbors list =
let random = new Random()
let index = random.Next(0, List.length list)
SwapWithNext index list

type City = { Name: string; X: float; Y: float; }

let Distance (city1, city2) =
((city1.X - city2.X) ** 2.0
+ (city1.Y - city2.Y) ** 2.0) ** 0.5

let CircuitCost list =
seq {
for i in 0 .. (List.length list - 1) -> list.[i]
}
|> Seq.pairwise
|> Seq.map Distance
|> Seq.sum

type Solution = { Route: List<City>; Cost: float }

let Evaluate (route: List<City>) = { Route = route; Cost = CircuitCost route }

type Bee =
| Scout of Solution
| Active of Solution * int
| Inactive of Solution

let Search bee (rng : Random) =
match bee with
| Scout solution ->
let newSolution = Evaluate (Shuffle rng solution.Route)
if newSolution.Cost < solution.Cost
then (Scout(newSolution), Some(newSolution))
else (bee, None)
| Active (solution, visits) ->
let newSolution = Evaluate (SwapRandomNeighbors solution.Route)
let proba = rng.NextDouble()
if newSolution.Cost < solution.Cost
then
if proba < probaFalseNegative
then (Active(solution, (visits + 1)), None)
else (Active(newSolution, 0), Some(newSolution))
else
if proba < probaFalsePositive
then (Active(newSolution, 0), Some(newSolution))
else (Active(solution, (visits + 1)), None)
| Inactive solution -> (bee, None)

let Solution bee =
match bee with
| Scout(solution) -> solution
| Inactive(solution) -> solution
| Active(solution, trips) -> solution

let (|RequiresUpdate|) bee =
match bee with
| Scout(solution) -> false
| Inactive(solution) -> true
| Active(solution, trips) -> trips > tripsLimit

let Waggle (solutions : List<Solution>) (bee : Bee) (rng : Random) =
match bee with
| RequiresUpdate true ->
let currentSolution = Solution bee
let newSolution = List.fold (fun acc element ->
if element.Cost < acc.Cost && rng.NextDouble() < probaConvince
then element else acc) currentSolution solutions
Inactive(newSolution)
| _ -> bee

let Promote bee =
match bee with
| Inactive(solution) -> Active(solution, 0)
| _ -> bee

let Activate rng inactives bees =
let inactiveIndexes =
List.mapi (fun i b -> match b with
| Inactive(solution) -> Some(i)
| _ -> None)
bees
|> List.choose (fun e -> e)
|> Shuffle rng

let promoted = (List.length inactiveIndexes) - inactives
let promotedIndexes = Seq.take promoted inactiveIndexes |> Seq.toList

bees |> List.mapi (
fun i b -> if List.exists (fun e -> e = i) promotedIndexes
then Promote b
else b)

let CountInactives hive =
hive |> List.choose (fun b -> match b with
| Inactive(solution) -> Some(b)
| _ -> None)
|> List.length

let Initialize nScouts nActives nInactives cities (rng : Random) =
[
for i in 1 .. nScouts do
let solution = Evaluate(Shuffle rng cities)
yield Scout(solution)
for i in 1 .. nActives do
let solution = Evaluate(Shuffle rng cities)
yield Active(solution, 0)
for i in 1 .. nActives do
let solution = Evaluate(Shuffle rng cities)
yield Inactive(solution)
]

let Update (hive, currentBest : Solution) rng =
let searchResult = List.map (fun b -> Search b rng) hive
let newSolutions = List.choose (fun e -> snd e) searchResult
let newBest = List.fold (fun best solution ->
if best.Cost < solution.Cost
then best
else solution) currentBest newSolutions
let inactives = CountInactives hive
let updatedHive = searchResult
|> List.map (fun b -> Waggle newSolutions (fst b) rng)
|> Activate rng inactives
(updatedHive, newBest)

let Solve scouts actives inactives route =
let rng = new Random()
let hive = Initialize scouts actives inactives route rng
let initialBest = List.map (fun b -> Solution b) hive
|> List.minBy (fun s -> s.Cost)
Seq.unfold (fun h -> Some(h, (Update h rng))) (hive, initialBest)


Then, the Program.fs file, which contains the Console application:

module Program

open System
open System.Diagnostics

[
let rng = new Random()
let letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
for i in 0 .. (points - 1) do
let angle = Math.PI * 2.0 * (double)i / (double)points
let name = letters.[i];
yield {
Solver.City.Name = (string)name;
Solver.City.Y = Math.Sin(angle) * radius }
]

[<EntryPoint>]
let main (args : string[]) =
printfn "Bee Hive colony at work!"

let stopwatch = new Stopwatch()
stopwatch.Start()

let rng = new Random()
let route = RandomRoute 100.0 26
let bestSolution = Solver.Evaluate route
printfn "Best possible cost: %f" bestSolution.Cost

let initialSolution = Solver.Evaluate (Solver.Shuffle rng route)
printfn "Initial cost: %f " initialSolution.Cost

let search = Solver.Solve 30 50 20 route
let solution = search |> Seq.nth 20000 |> snd

stopwatch.Stop()
printfn "Milliseconds: %d" stopwatch.ElapsedMilliseconds

printfn "Solution cost: %f" solution.Cost
solution.Route |> List.iter (fun c -> printf "%s " c.Name)

printfn ""
printfn "Press enter to close"