X-Git-Url: http://git.euphorik.ch/?p=master-thesis.git;a=blobdiff_plain;f=Parasitemia%2FParasitemiaCore%2FKdTree.fs;fp=Parasitemia%2FParasitemiaCore%2FKdTree.fs;h=94a3921e8bad8e36864ab8247b7a12b95c439533;hp=0000000000000000000000000000000000000000;hb=4bfa3cbdc6145e6944f02e24829ab2ef3a851ac1;hpb=48ecdfc43001c444eff6ad442986049384674af2

diff --git a/Parasitemia/ParasitemiaCore/KdTree.fs b/Parasitemia/ParasitemiaCore/KdTree.fs
new file mode 100644
index 0000000..94a3921
--- /dev/null
+++ b/Parasitemia/ParasitemiaCore/KdTree.fs
@@ -0,0 +1,153 @@
+module ParasitemiaCore.KdTree
+
+open System
+
+type I2DCoords =
+    abstract X : float32
+    abstract Y : float32
+
+// Compare 'e1' and 'e2' by X.
+let cmpX (e1: I2DCoords) (e2: I2DCoords) : int =
+    match e1.X.CompareTo(e2.X) with
+    | 0 -> match e1.Y.CompareTo(e2.Y) with
+           | 0 -> e1.GetHashCode().CompareTo(e2.GetHashCode())
+           | v -> v
+    | v -> v
+
+// Compare 'e1' and 'e2' by Y.
+let cmpY (e1: I2DCoords) (e2: I2DCoords) : int =
+    match e1.Y.CompareTo(e2.Y) with
+    | 0 -> match e1.X.CompareTo(e2.X) with
+           | 0 -> e1.GetHashCode().CompareTo(e2.GetHashCode())
+           | v -> v
+    | v -> v
+
+type Region = { minX: float32; maxX: float32; minY: float32; maxY: float32 } with
+    member this.Contains px py : bool =
+        px >= this.minX && px <= this.maxX &&
+        py >= this.minY && py <= this.maxY
+
+    member this.IsSub otherRegion : bool =
+        this.minX >= otherRegion.minX && this.maxX <= otherRegion.maxX &&
+        this.minY >= otherRegion.minY && this.maxY <= otherRegion.maxY
+
+    member this.Intersects otherRegion : bool =
+        this.minX < otherRegion.maxX && this.maxX >= otherRegion.minX &&
+        this.minY < otherRegion.maxY && this.maxY >= otherRegion.minY
+
+type Tree<'a when 'a :> I2DCoords> =
+    | Node of float32 * Tree<'a> * Tree<'a>
+    | Leaf of 'a
+
+    static member BuildTree (l: 'a list) : Tree<'a> =
+        let xSorted = List.toArray l
+        let ySorted = List.toArray l
+        Array.sortInPlaceWith cmpX xSorted
+        Array.sortInPlaceWith cmpY ySorted
+
+        let rec buildTreeFromSortedArray (pXSorted: 'a[]) (pYSorted: 'a[]) (depth: int) : Tree<'a> =
+            if pXSorted.Length = 1
+            then
+                Leaf pXSorted.[0]
+            else
+                if depth % 2 = 1 // 'depth' is odd -> vertical splitting else horizontal splitting.
+                then
+                    let leftX, rightX = Array.splitAt ((pXSorted.Length + 1) / 2) pXSorted
+                    let splitElement = Array.last leftX
+                    let leftY, rightY = Array.partition (fun (e: 'a) -> cmpX e splitElement <= 0) pYSorted // FIXME: Maybe this operation can be optimized.
+                    Node (splitElement.X, buildTreeFromSortedArray leftX leftY (depth + 1), buildTreeFromSortedArray rightX rightY (depth + 1))
+                else
+                    let downY, upY = Array.splitAt ((pYSorted.Length + 1) / 2) pYSorted
+                    let splitElement = Array.last downY
+                    let downX, upX = Array.partition (fun (e: 'a) -> cmpY e splitElement <= 0) pXSorted // FIXME: Maybe this operation can be optimized.
+                    Node (splitElement.Y, buildTreeFromSortedArray downX downY (depth + 1), buildTreeFromSortedArray upX upY (depth + 1))
+
+        buildTreeFromSortedArray xSorted ySorted 1
+
+    member this.Search (searchRegion: Region) : 'a list =
+        let rec valuesFrom (tree: Tree<'a>) : 'a list =
+            match tree with
+            | Leaf v -> [v]
+            | Node (_, part1, part2) -> (valuesFrom part1) @ (valuesFrom part2)
+
+        let rec searchWithRegion (tree: Tree<'a>) (currentRegion: Region) (depth: int) : 'a list =
+            match tree with
+            | Leaf v -> if searchRegion.Contains v.X v.Y then [v] else []
+            | Node (splitValue, part1, part2) ->
+                let valuesInRegion (region: Region) (treeRegion: Tree<'a>) =
+                    if region.IsSub searchRegion
+                    then
+                        valuesFrom treeRegion
+                    elif region.Intersects searchRegion
+                    then
+                        searchWithRegion treeRegion region (depth + 1)
+                    else
+                        []
+
+                if depth % 2 = 1 // Vertical splitting.
+                then
+                    let leftRegion = { currentRegion with maxX = splitValue }
+                    let rightRegion = { currentRegion with minX = splitValue }
+                    (valuesInRegion leftRegion part1) @ (valuesInRegion rightRegion part2)
+                else // Horizontal splitting.
+                    let downRegion = { currentRegion with maxY = splitValue }
+                    let upRegion = { currentRegion with minY = splitValue }
+                    (valuesInRegion downRegion part1) @ (valuesInRegion upRegion part2)
+
+        searchWithRegion this { minX = Single.MinValue; maxX = Single.MaxValue; minY = Single.MinValue; maxY = Single.MaxValue } 1
+
+///// Tests. TODO: to put in a unit test.
+
+type Point (x: float32, y: float32) =
+    interface I2DCoords with
+        member this.X = x
+        member this.Y = y
+
+    override this.ToString () =
+        sprintf "(%.1f, %.1f)" x y
+
+// TODO: test with identical X or Y coords
+let test () =
+    let pts = [
+        Point(1.0f, 1.0f)
+        Point(2.0f, 2.0f)
+        Point(1.5f, 3.6f)
+        Point(3.0f, 3.2f)
+        Point(4.0f, 4.0f)
+        Point(3.5f, 1.5f)
+        Point(2.5f, 0.5f) ]
+
+    let tree = Tree.BuildTree pts
+    Utils.dprintfn "Tree: %A" tree
+
+    let s1 = tree.Search { minX = 0.0f; maxX = 5.0f; minY = 0.0f; maxY = 5.0f } // All points.
+    Utils.dprintfn "s1: %A" s1
+
+    let s2 = tree.Search { minX = 2.8f; maxX = 4.5f; minY = 3.0f; maxY = 4.5f }
+    Utils.dprintfn "s2: %A" s2
+
+    let s3 = tree.Search { minX = 2.0f; maxX = 2.0f; minY = 2.0f; maxY = 2.0f }
+    Utils.dprintfn "s3: %A" s3
+
+let test2 () =
+    let pts = [
+        Point(1.0f, 1.0f)
+        Point(1.0f, 2.0f)
+        Point(1.0f, 3.0f) ]
+
+    let tree = Tree.BuildTree pts
+    Utils.dprintfn "Tree: %A" tree
+
+    let s1 = tree.Search { minX = 1.0f; maxX = 1.0f; minY = 1.0f; maxY = 1.0f }
+    Utils.dprintfn "s1: %A" s1
+
+    let s2 = tree.Search { minX = 1.0f; maxX = 1.0f; minY = 2.0f; maxY = 2.0f }
+    Utils.dprintfn "s2: %A" s2
+
+    // This case result is wrong: FIXME
+    let s3 = tree.Search { minX = 1.0f; maxX = 1.0f; minY = 3.0f; maxY = 3.0f }
+    Utils.dprintfn "s3: %A" s3
+
+    let s4 = tree.Search { minX = 0.0f; maxX = 2.0f; minY = 0.0f; maxY = 4.0f }
+    Utils.dprintfn "s4: %A" s4
+