X-Git-Url: http://git.euphorik.ch/?a=blobdiff_plain;f=Parasitemia%2FParasitemia%2FKdTree.fs;fp=Parasitemia%2FParasitemia%2FKdTree.fs;h=0000000000000000000000000000000000000000;hb=4bfa3cbdc6145e6944f02e24829ab2ef3a851ac1;hp=04a1152163f60bec2acd15ba8d4d2f7fc41b43c8;hpb=48ecdfc43001c444eff6ad442986049384674af2;p=master-thesis.git diff --git a/Parasitemia/Parasitemia/KdTree.fs b/Parasitemia/Parasitemia/KdTree.fs deleted file mode 100644 index 04a1152..0000000 --- a/Parasitemia/Parasitemia/KdTree.fs +++ /dev/null @@ -1,153 +0,0 @@ -module 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 -