4 people like it.
Like the snippet!

A Simple F# QuadTree

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46:

open System.Drawing

type IQuadable = 
    abstract member Bounds : Rectangle

type SubNodes = { NW: QuadNode; NE: QuadNode; SE: QuadNode; SW: QuadNode }
and QuadNode = { Bounds: Rectangle; mutable Contents: List<IQuadable>; SubNodes: Option<SubNodes> }

module QuadTree =
    let contains (tree: QuadNode) (bounds: Rectangle) = tree.Bounds.Contains bounds

    let getConstrainingNode (tree: QuadNode) (elementBounds: Rectangle) : QuadNode = 
        let rec contrainingRec currentNode = 
            match currentNode.SubNodes with
            | None -> currentNode
            | Some (subTree) -> 
                [ subTree.NE; subTree.NW; subTree.SE; subTree.SW ]
                |> List.filter (fun n -> n.Bounds.Contains elementBounds)
                |> function 
                   | [] -> currentNode
                   | head :: [] -> head
                   | _ -> currentNode
        contrainingRec tree

    let add (tree: QuadNode) (element: IQuadable) =
        let target = getConstrainingNode tree element.Bounds
        target.Contents <- element :: target.Contents
        tree
             
    let init (elements: IQuadable list) (depth: int) =
        let maxBounds = elements
                        |> List.map (fun x -> x.Bounds) 
                        |> List.fold (fun a r -> Rectangle.Union(a, r)) Rectangle.Empty
        let rec buildTree nodeBounds = 
            function
            | 0 -> { Bounds = nodeBounds; Contents = List.empty; SubNodes = None }
            | curDepth -> let midPoint = Point(nodeBounds.Width - nodeBounds.X, nodeBounds.Height - nodeBounds.Y) in
                            { Bounds = nodeBounds; 
                              Contents = List.empty;
                              SubNodes = Some { NW = buildTree <| Rectangle.FromLTRB(nodeBounds.X, nodeBounds.Y, midPoint.X, midPoint.Y) <| curDepth - 1;
                                                SW = buildTree <| Rectangle.FromLTRB(nodeBounds.X, midPoint.Y, midPoint.X, nodeBounds.Y) <| curDepth - 1;
                                                NE = buildTree <| Rectangle.FromLTRB(midPoint.X, nodeBounds.Y, nodeBounds.X, midPoint.Y) <| curDepth - 1;
                                                SE = buildTree <| Rectangle.FromLTRB(midPoint.X, midPoint.Y, nodeBounds.X, nodeBounds.Y) <| curDepth - 1; } }
 
        let emptyTree = buildTree maxBounds depth
        List.fold (add) emptyTree elements

namespace System

namespace System.Drawing

type IQuadable =
  interface
    abstract member Bounds : Rectangle
  end

Full name: Script.IQuadable

abstract member IQuadable.Bounds : Rectangle

Full name: Script.IQuadable.Bounds

Multiple items
type Rectangle =
  struct
    new : location:Point * size:Size -> Rectangle + 1 overload
    member Bottom : int
    member Contains : pt:Point -> bool + 2 overloads
    member Equals : obj:obj -> bool
    member GetHashCode : unit -> int
    member Height : int with get, set
    member Inflate : size:Size -> unit + 1 overload
    member Intersect : rect:Rectangle -> unit
    member IntersectsWith : rect:Rectangle -> bool
    member IsEmpty : bool
    ...
  end

Full name: System.Drawing.Rectangle

--------------------
Rectangle()
Rectangle(location: Point, size: Size) : unit
Rectangle(x: int, y: int, width: int, height: int) : unit

type SubNodes =
  {NW: QuadNode;
   NE: QuadNode;
   SE: QuadNode;
   SW: QuadNode;}

Full name: Script.SubNodes

SubNodes.NW: QuadNode

type QuadNode =
  {Bounds: Rectangle;
   mutable Contents: List<IQuadable>;
   SubNodes: Option<SubNodes>;}

Full name: Script.QuadNode

SubNodes.NE: QuadNode

SubNodes.SE: QuadNode

SubNodes.SW: QuadNode

QuadNode.Bounds: Rectangle

QuadNode.Contents: List<IQuadable>

Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>

Multiple items
QuadNode.SubNodes: Option<SubNodes>

--------------------
type SubNodes =
  {NW: QuadNode;
   NE: QuadNode;
   SE: QuadNode;
   SW: QuadNode;}

Full name: Script.SubNodes

module Option

from Microsoft.FSharp.Core

module QuadTree

from Script

val contains : tree:QuadNode -> bounds:Rectangle -> bool

Full name: Script.QuadTree.contains

val tree : QuadNode

val bounds : Rectangle

Rectangle.Contains(rect: Rectangle) : bool
Rectangle.Contains(pt: Point) : bool
Rectangle.Contains(x: int, y: int) : bool

val getConstrainingNode : tree:QuadNode -> elementBounds:Rectangle -> QuadNode

Full name: Script.QuadTree.getConstrainingNode

val elementBounds : Rectangle

val contrainingRec : (QuadNode -> QuadNode)

val currentNode : QuadNode

QuadNode.SubNodes: Option<SubNodes>

union case Option.None: Option<'T>

union case Option.Some: Value: 'T -> Option<'T>

val subTree : SubNodes

val filter : predicate:('T -> bool) -> list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.filter

val n : QuadNode

val head : QuadNode

val add : tree:QuadNode -> element:IQuadable -> QuadNode

Full name: Script.QuadTree.add

val element : IQuadable

val target : QuadNode

property IQuadable.Bounds: Rectangle

val init : elements:IQuadable list -> depth:int -> QuadNode

Full name: Script.QuadTree.init

val elements : IQuadable list

type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>

val depth : int

Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

val maxBounds : Rectangle

val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map

val x : IQuadable

val fold : folder:('State -> 'T -> 'State) -> state:'State -> list:'T list -> 'State

Full name: Microsoft.FSharp.Collections.List.fold

val a : Rectangle

val r : Rectangle

Rectangle.Union(a: Rectangle, b: Rectangle) : Rectangle

field Rectangle.Empty

val buildTree : (Rectangle -> int -> QuadNode)

val nodeBounds : Rectangle

val empty<'T> : 'T list

Full name: Microsoft.FSharp.Collections.List.empty

val curDepth : int

val midPoint : Point

Multiple items
type Point =
  struct
    new : sz:Size -> Point + 2 overloads
    member Equals : obj:obj -> bool
    member GetHashCode : unit -> int
    member IsEmpty : bool
    member Offset : p:Point -> unit + 1 overload
    member ToString : unit -> string
    member X : int with get, set
    member Y : int with get, set
    static val Empty : Point
    static member Add : pt:Point * sz:Size -> Point
    ...
  end

Full name: System.Drawing.Point

--------------------
Point()
Point(sz: Size) : unit
Point(dw: int) : unit
Point(x: int, y: int) : unit

property Rectangle.Width: int

property Rectangle.X: int

property Rectangle.Height: int

property Rectangle.Y: int

Rectangle.FromLTRB(left: int, top: int, right: int, bottom: int) : Rectangle

property Point.X: int

property Point.Y: int

val emptyTree : QuadNode

Raw view Test code New version

More information

Link:	http://fssnip.net/2o
Posted:	15 years ago
Author:
Tags: