The code sample below was inspired by the following StackOverflow question on bipartite matching.
There are N starting points (purple) and N target points (green) in 2D. I want an algorithm that connects starting points to target points by a line segment (brown) without any of these segments intersecting (red) and while minimizing the cumulative length of all segments.
Check out this blog post for comments on the implementation!

open ClearLines.Bumblebee
open System

type Point = { X: float; Y: float }

let Main = 
   
   let rng = new Random()

   let points = 100
   let firstList = [ for i in 0 .. points -> { X = (float)i ; Y = float(i) } ]
   let secondList =  [ for i in 0 .. points -> { X = (float)i ; Y = float(i) } ]

   let root = firstList, secondList

   let swapper (first, second) index =
      if index = first then second
      elif index = second then first
      else index

   let swap list (rng: Random) =
      let last = List.length list
      let first = rng.Next(last)
      let second = rng.Next(last)
      List.permute (fun i -> swapper (first, second) i) list
    
   let shuffle (rng: Random) list =
      let rec shuffleUpTo index (array: int[]) =
         match index with
         | 0 -> array
         | _ ->
            let swapIndex = rng.Next(index + 1)
            let temp = array.[index]
            array.[index] <- array.[swapIndex]
            array.[swapIndex] <- temp
            shuffleUpTo (index - 1) array
      let lastIndex = (List.length list - 1)
      let shuffled = shuffleUpTo lastIndex [| 0 .. lastIndex |]
      List.permute (fun i -> shuffled.[i]) list
                         
   let generate = fun (rng: Random) ->
      (fst root |> shuffle rng, snd root)

   let mutate = fun (rng: Random, solution) -> 
      (swap (fst solution) rng, snd solution)

   let distance pair =
      ((fst pair).X - (snd pair).X) ** 2.0 + ((fst pair).Y - (snd pair).Y) ** 2.0

   let evaluate = fun (solution: Point list * Point list) -> 
      List.zip (fst solution) (snd solution)
      |> List.sumBy (fun p -> - distance p)

   let problem = new Problem<Point list * Point list>(generate, mutate, evaluate)
   let solver = new Solver<Point list * Point list>()

   let foundSomething = fun (msg: SolutionMessage<Point list * Point list>) -> 
      Console.WriteLine("New solution of quality {0} found at {1}", msg.Quality, msg.DateTime.TimeOfDay) 

   solver.FoundSolution.Add foundSomething
         
   solver.Search(problem) |> ignore

   Console.ReadLine() |> ignore

Last edited Apr 1, 2012 at 10:55 PM by mathiasb, version 1

Comments

No comments yet.