X-Git-Url: http://git.euphorik.ch/?p=master-thesis.git;a=blobdiff_plain;f=Parasitemia%2FParasitemiaCore%2FKdTree.fs;h=4e20f242497135266d6fedac3b6d47f18122ceaf;hp=3a6097773ec2ab6116f79c5e33257a22e83006b4;hb=b87b35b922551f122228df1fd9c530bbb807935a;hpb=2e3cd07dd099944059ef5e7a7f5ef57ffe3d677b diff --git a/Parasitemia/ParasitemiaCore/KdTree.fs b/Parasitemia/ParasitemiaCore/KdTree.fs index 3a60977..4e20f24 100644 --- a/Parasitemia/ParasitemiaCore/KdTree.fs +++ b/Parasitemia/ParasitemiaCore/KdTree.fs @@ -7,7 +7,7 @@ type I2DCoords = abstract Y : float32 // Compare 'e1' and 'e2' by X. -let cmpX (e1: I2DCoords) (e2: I2DCoords) : int = +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()) @@ -15,14 +15,14 @@ let cmpX (e1: I2DCoords) (e2: I2DCoords) : int = | v -> v // Compare 'e1' and 'e2' by Y. -let cmpY (e1: I2DCoords) (e2: I2DCoords) : int = +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 +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 @@ -39,53 +39,48 @@ type Tree<'a when 'a :> I2DCoords> = | Node of float32 * Tree<'a> * Tree<'a> | Leaf of 'a - static member BuildTree (l: 'a list) : Tree<'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 + 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 + if depth % 2 = 1 then // 'depth' is odd -> vertical splitting else horizontal splitting. 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. + 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. + 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>) (acc: 'a list) : 'a list = + member this.Search (searchRegion : Region) : 'a list = + let rec valuesFrom (tree : Tree<'a>) (acc : 'a list) : 'a list = match tree with | Node (_, left, right) -> (valuesFrom right (valuesFrom left acc)) | Leaf v -> v :: acc - let rec searchWithRegion (tree: Tree<'a>) (currentRegion: Region) (depth: int) : 'a list = + 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 + let valuesInRegion (region : Region) (treeRegion : Tree<'a>) = + if region.IsSub searchRegion then valuesFrom treeRegion [] - elif region.Intersects searchRegion - then + elif region.Intersects searchRegion then searchWithRegion treeRegion region (depth + 1) else [] - if depth % 2 = 1 // Vertical splitting. - then + if depth % 2 = 1 then // Vertical splitting. let leftRegion = { currentRegion with maxX = splitValue } let rightRegion = { currentRegion with minX = splitValue } (valuesInRegion leftRegion part1) @ (valuesInRegion rightRegion part2) @@ -98,7 +93,7 @@ type Tree<'a when 'a :> I2DCoords> = ///// Tests. TODO: to put in a unit test. -type Point (x: float32, y: float32) = +type Point (x : float32, y : float32) = interface I2DCoords with member this.X = x member this.Y = y @@ -108,14 +103,16 @@ type Point (x: float32, y: float32) = // 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 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 @@ -130,10 +127,12 @@ let test () = 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 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