1
module ParasitemiaCore.KdTree
4 open System.Collections.Generic
10 // Compare 'e1' and 'e2' by X.
11 let cmpX (e1
: I2DCoords) (e2
: I2DCoords) : int =
12 match e1
.X.CompareTo e2
.X with
13 | 0 -> match e1
.Y.CompareTo e2
.Y with
14 | 0 -> e1
.GetHashCode().CompareTo (e2
.GetHashCode ())
18 // Compare 'e1' and 'e2' by Y.
19 let cmpY (e1
: I2DCoords) (e2
: I2DCoords) : int =
20 match e1
.Y.CompareTo e2
.Y with
21 | 0 -> match e1
.X.CompareTo e2
.X with
22 | 0 -> e1
.GetHashCode().CompareTo (e2
.GetHashCode ())
26 type Region = { minX
: float32
; maxX
: float32
; minY
: float32
; maxY
: float32
} with
27 member this
.Contains px py
: bool =
28 px >= this
.minX
&& px <= this
.maxX
&&
29 py
>= this
.minY
&& py
<= this
.maxY
31 member this
.IsSub otherRegion
: bool =
32 this
.minX
>= otherRegion
.minX
&& this
.maxX
<= otherRegion
.maxX
&&
33 this
.minY
>= otherRegion
.minY
&& this
.maxY
<= otherRegion
.maxY
35 member this
.Intersects otherRegion : bool =
36 this
.minX
< otherRegion.maxX
&& this
.maxX
>= otherRegion.minX
&&
37 this
.minY
< otherRegion.maxY
&& this
.maxY
>= otherRegion.minY
39 type Tree<'a when 'a
:> I2DCoords> =
40 | Node of float32
* Tree<'a> * Tree<'a
>
43 static member BuildTree (l : 'a list
) : Tree<'a> =
44 let xSorted = List.toArray l
45 let ySorted = List.toArray l
46 Array.sortInPlaceWith cmpX xSorted
47 Array.sortInPlaceWith cmpY ySorted
49 let rec buildTreeFromSortedArray (pXSorted : 'a
[]) (pYSorted
: 'a[]) (depth : int) : Tree<'a
> =
50 if pXSorted
.Length = 1 then
53 if depth
% 2 = 1 then // 'depth' is odd -> vertical splitting else horizontal splitting.
54 let leftX, rightX
= Array.splitAt
((pXSorted
.Length + 1) / 2) pXSorted
55 let splitElement = Array.last
leftX
56 let leftY, rightY
= Array.partition
(fun (e
: 'a) -> cmpX e splitElement <= 0) pYSorted // FIXME: Maybe this operation can be optimized.
57 Node (splitElement.X, buildTreeFromSortedArray leftX leftY (depth + 1), buildTreeFromSortedArray rightX rightY (depth + 1))
59 let downY, upY = Array.splitAt ((pYSorted.Length + 1) / 2) pYSorted
60 let splitElement = Array.last downY
61 let downX, upX = Array.partition (fun (e : 'a
) -> cmpY e
splitElement <= 0) pXSorted
// FIXME: Maybe this operation can be optimized.
62 Node (splitElement.Y, buildTreeFromSortedArray
downX downY (depth
+ 1), buildTreeFromSortedArray upX upY
(depth
+ 1))
64 buildTreeFromSortedArray
xSorted ySorted 1
66 member this.Search (searchRegion
: Region) : List<'a> =
67 let result = List<'a
> ()
68 let rec valuesFrom
(tree
: Tree<'a>) =
70 | Node (_, left, right) ->
76 let rec searchWithRegion (tree : Tree<'a
>) (currentRegion
: Region) (depth
: int) =
79 if searchRegion
.Contains v.X v.Y then
81 | Node (splitValue
, part1
, part2
) ->
82 let inline valuesInRegion
(region
: Region) (treeRegion
: Tree<'a>) =
83 if region.IsSub searchRegion then
85 elif region.Intersects searchRegion then
86 searchWithRegion treeRegion region (depth + 1)
88 if depth % 2 = 1 then // Vertical splitting.
89 valuesInRegion { currentRegion with maxX = splitValue } part1 // Left region.
90 valuesInRegion { currentRegion with minX = splitValue } part2 // Right region.
91 else // Horizontal splitting.
92 valuesInRegion { currentRegion with maxY = splitValue } part1 // Down region.
93 valuesInRegion { currentRegion with minY = splitValue } part2 // Up region.
95 searchWithRegion this { minX = Single.MinValue; maxX = Single.MaxValue; minY = Single.MinValue; maxY = Single.MaxValue } 1
99 member this.SearchOld (searchRegion : Region) : 'a list
=
100 let rec valuesFrom
(tree
: Tree<'a>) (acc : 'a list
) : 'a list =
102 | Node (_, left, right) -> (valuesFrom right (valuesFrom left acc))
105 let rec searchWithRegion (tree : Tree<'a
>) (currentRegion
: Region) (depth
: int) : 'a list =
107 | Leaf v -> if searchRegion.Contains v.X v.Y then [v] else []
108 | Node (splitValue, part1, part2) ->
109 let valuesInRegion (region : Region) (treeRegion : Tree<'a
>) =
110 if region.IsSub searchRegion then
111 valuesFrom treeRegion
[]
112 elif
region.Intersects searchRegion then
113 searchWithRegion treeRegion
region (depth
+ 1)
117 if depth
% 2 = 1 then // Vertical splitting.
118 let leftRegion = { currentRegion
with maxX
= splitValue
}
119 let rightRegion = { currentRegion
with minX
= splitValue
}
120 (valuesInRegion leftRegion part1
) @ (valuesInRegion rightRegion part2
)
121 else // Horizontal splitting.
122 let downRegion = { currentRegion
with maxY
= splitValue
}
123 let upRegion = { currentRegion
with minY
= splitValue
}
124 (valuesInRegion downRegion part1
) @ (valuesInRegion upRegion part2
)
126 searchWithRegion
this { minX
= Single.MinValue; maxX
= Single.MaxValue; minY
= Single.MinValue; maxY
= Single.MaxValue } 1