X-Git-Url: http://git.euphorik.ch/?a=blobdiff_plain;ds=sidebyside;f=Parasitemia%2FParasitemiaCore%2FKdTree.fs;h=ec21a0f35d28491dd91c40149f26ee1a3363d896;hb=6250f10c807301a760b8659f9c00ca6dbbd4c7b7;hp=2525e272cdeca45051975e2ce2d20474794e2a07;hpb=2d712781def419c9acc98368f7102b19b064f16d;p=master-thesis.git diff --git a/Parasitemia/ParasitemiaCore/KdTree.fs b/Parasitemia/ParasitemiaCore/KdTree.fs index 2525e27..ec21a0f 100644 --- a/Parasitemia/ParasitemiaCore/KdTree.fs +++ b/Parasitemia/ParasitemiaCore/KdTree.fs @@ -1,6 +1,7 @@ module ParasitemiaCore.KdTree open System +open System.Collections.Generic type I2DCoords = abstract X : float32 @@ -62,7 +63,40 @@ type Tree<'a when 'a :> I2DCoords> = buildTreeFromSortedArray xSorted ySorted 1 - member this.Search (searchRegion : Region) : 'a list = + member this.Search (searchRegion : Region) : List<'a> = + let result = List<'a> () + let rec valuesFrom (tree : Tree<'a>) = + match tree with + | Node (_, left, right) -> + valuesFrom right + valuesFrom left + | Leaf v -> + result.Add v + + let rec searchWithRegion (tree : Tree<'a>) (currentRegion : Region) (depth : int) = + match tree with + | Leaf v -> + if searchRegion.Contains v.X v.Y then + result.Add v + | Node (splitValue, part1, part2) -> + let inline valuesInRegion (region : Region) (treeRegion : Tree<'a>) = + if region.IsSub searchRegion then + valuesFrom treeRegion + elif region.Intersects searchRegion then + searchWithRegion treeRegion region (depth + 1) + + if depth % 2 = 1 then // Vertical splitting. + valuesInRegion { currentRegion with maxX = splitValue } part1 // Left region. + valuesInRegion { currentRegion with minX = splitValue } part2 // Right region. + else // Horizontal splitting. + valuesInRegion { currentRegion with maxY = splitValue } part1 // Down region. + valuesInRegion { currentRegion with minY = splitValue } part2 // Up region. + + searchWithRegion this { minX = Single.MinValue; maxX = Single.MaxValue; minY = Single.MinValue; maxY = Single.MaxValue } 1 + result + + [] + member this.SearchOld (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))