CodePlexProject Hosting for Open Source Software

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!

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 11:55 PM by mathiasb, version 1