Version 1.0.10
[master-thesis.git] / Parasitemia / ParasitemiaCore / KdTree.fs
1 module ParasitemiaCore.KdTree
2
3 open System
4
5 type I2DCoords =
6 abstract X : float32
7 abstract Y : float32
8
9 // Compare 'e1' and 'e2' by X.
10 let cmpX (e1 : I2DCoords) (e2 : I2DCoords) : int =
11 match e1.X.CompareTo(e2.X) with
12 | 0 -> match e1.Y.CompareTo(e2.Y) with
13 | 0 -> e1.GetHashCode().CompareTo(e2.GetHashCode())
14 | v -> v
15 | v -> v
16
17 // Compare 'e1' and 'e2' by Y.
18 let cmpY (e1 : I2DCoords) (e2 : I2DCoords) : int =
19 match e1.Y.CompareTo(e2.Y) with
20 | 0 -> match e1.X.CompareTo(e2.X) with
21 | 0 -> e1.GetHashCode().CompareTo(e2.GetHashCode())
22 | v -> v
23 | v -> v
24
25 type Region = { minX : float32; maxX : float32; minY : float32; maxY : float32 } with
26 member this.Contains px py : bool =
27 px >= this.minX && px <= this.maxX &&
28 py >= this.minY && py <= this.maxY
29
30 member this.IsSub otherRegion : bool =
31 this.minX >= otherRegion.minX && this.maxX <= otherRegion.maxX &&
32 this.minY >= otherRegion.minY && this.maxY <= otherRegion.maxY
33
34 member this.Intersects otherRegion : bool =
35 this.minX < otherRegion.maxX && this.maxX >= otherRegion.minX &&
36 this.minY < otherRegion.maxY && this.maxY >= otherRegion.minY
37
38 type Tree<'a when 'a :> I2DCoords> =
39 | Node of float32 * Tree<'a> * Tree<'a>
40 | Leaf of 'a
41
42 static member BuildTree (l : 'a list) : Tree<'a> =
43 let xSorted = List.toArray l
44 let ySorted = List.toArray l
45 Array.sortInPlaceWith cmpX xSorted
46 Array.sortInPlaceWith cmpY ySorted
47
48 let rec buildTreeFromSortedArray (pXSorted : 'a[]) (pYSorted : 'a[]) (depth : int) : Tree<'a> =
49 if pXSorted.Length = 1 then
50 Leaf pXSorted.[0]
51 else
52 if depth % 2 = 1 then // 'depth' is odd -> vertical splitting else horizontal splitting.
53 let leftX, rightX = Array.splitAt ((pXSorted.Length + 1) / 2) pXSorted
54 let splitElement = Array.last leftX
55 let leftY, rightY = Array.partition (fun (e : 'a) -> cmpX e splitElement <= 0) pYSorted // FIXME: Maybe this operation can be optimized.
56 Node (splitElement.X, buildTreeFromSortedArray leftX leftY (depth + 1), buildTreeFromSortedArray rightX rightY (depth + 1))
57 else
58 let downY, upY = Array.splitAt ((pYSorted.Length + 1) / 2) pYSorted
59 let splitElement = Array.last downY
60 let downX, upX = Array.partition (fun (e : 'a) -> cmpY e splitElement <= 0) pXSorted // FIXME: Maybe this operation can be optimized.
61 Node (splitElement.Y, buildTreeFromSortedArray downX downY (depth + 1), buildTreeFromSortedArray upX upY (depth + 1))
62
63 buildTreeFromSortedArray xSorted ySorted 1
64
65 member this.Search (searchRegion : Region) : 'a list =
66 let rec valuesFrom (tree : Tree<'a>) (acc : 'a list) : 'a list =
67 match tree with
68 | Node (_, left, right) -> (valuesFrom right (valuesFrom left acc))
69 | Leaf v -> v :: acc
70
71 let rec searchWithRegion (tree : Tree<'a>) (currentRegion : Region) (depth : int) : 'a list =
72 match tree with
73 | Leaf v -> if searchRegion.Contains v.X v.Y then [v] else []
74 | Node (splitValue, part1, part2) ->
75 let valuesInRegion (region : Region) (treeRegion : Tree<'a>) =
76 if region.IsSub searchRegion then
77 valuesFrom treeRegion []
78 elif region.Intersects searchRegion then
79 searchWithRegion treeRegion region (depth + 1)
80 else
81 []
82
83 if depth % 2 = 1 then // Vertical splitting.
84 let leftRegion = { currentRegion with maxX = splitValue }
85 let rightRegion = { currentRegion with minX = splitValue }
86 (valuesInRegion leftRegion part1) @ (valuesInRegion rightRegion part2)
87 else // Horizontal splitting.
88 let downRegion = { currentRegion with maxY = splitValue }
89 let upRegion = { currentRegion with minY = splitValue }
90 (valuesInRegion downRegion part1) @ (valuesInRegion upRegion part2)
91
92 searchWithRegion this { minX = Single.MinValue; maxX = Single.MaxValue; minY = Single.MinValue; maxY = Single.MaxValue } 1