2 people like it.

STRTree

Read-only STRtree backed by NetTopologySuite.Spatial.Index.STRTree

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81: 
82: 
83: 
84: 
85: 
86: 
87: 
88: 
89: 
90: 
91: 
92: 
93: 
type private InternalElement<'Key, 'Value when 'Key: comparison> =
  { key: 'Key
    data: 'Value
    polygon: Polygon }

[<Struct>]
type STRtree<'Key, 'Value when 'Key: comparison> =
  private { map: Map<'Key, InternalElement<'Key, 'Value>>
            strTree: NetTopologySuite.Index.Strtree.STRtree<InternalElement<'Key, 'Value>> }

[<RequireQualifiedAccess>]
module STRtree =
  [<AutoOpen>]
  module private Helper =
    /// Tests where a point is contained is polygon.
    /// Adapted from https://corstianboerman.com/posts/2018-10-08/retrieving-all-polygons-that-overlap-a-single-point.html
    let isPointInPolygon (testPoint: Coordinate) (polygon: Polygon) =
      let polygon = polygon.Coordinates
      
      let mutable result = false
      let mutable j = polygon.Length - 1
      for i = 0 to polygon.Length - 1 do
        if (polygon.[i].Y < testPoint.Y && polygon.[j].Y >= testPoint.Y ||
            polygon.[j].Y < testPoint.Y && polygon.[i].Y >= testPoint.Y) then
          if (polygon.[i].X + (testPoint.Y - polygon.[i].Y) / (polygon.[j].Y - polygon.[i].Y) * (polygon.[j].X - polygon.[i].X) < testPoint.X) then
            result <- not result
        j <- i
        
      result

    let createInternalElem (entity: 'Key * 'Value * Geometry) =
     let (key, element, geom) = entity
     { key = key
       data = element
       polygon = geom.GetUnionizedPolygons() }
      
    let createEmptyTree () = NetTopologySuite.Index.Strtree.STRtree<InternalElement<_, _>>()

  /// an empty type
  [<GeneralizableValue>]
  let empty<'Key, 'Value when 'Key: comparison> : STRtree<'Key, 'Value> =
    let tree = createEmptyTree ()
    { strTree = tree; map = Map.empty }

  /// Constructs the tree from sequence of value and their geometries
  let ofSeq (entities: seq<'Key * 'Value * Geometry>) =
    let map =
      Array.ofSeq entities
      |> Array.map (createInternalElem)
      |> Array.map (fun elem -> elem.key, elem)
      |> Map.ofSeq

    let _values = Map.values map
    let tree = createEmptyTree ()
    
    for p in _values do
      let envelope = p.polygon.EnvelopeInternal
      tree.Insert(envelope, p)

    tree.Build()
    { strTree = tree; map = map }

  /// Returns items whose polygons intersect the given envelope
  let queryEnvelope (envelope: Envelope) (tree: STRtree<_, _>) =
    tree.strTree.Query(envelope)
    |> Seq.map (fun elem -> elem.data)
    |> Seq.toList
    
  /// Returns items whose polygons intersect the given geometry
  let queryGeometry (geometry: Geometry) (tree: STRtree<_, _>) =
    tree.strTree.Query(geometry.EnvelopeInternal)
    |> Seq.filter (fun item -> geometry.Intersects(item.polygon))
    |> Seq.map (fun elem -> elem.data)
    |> Seq.toList

  /// Returns items whose polygons intersect geometry of the given key
  let neighbours (key: 'Key) (tree: STRtree<_, _>) =
    match tree.map.TryFind key with
    | None -> []
    | Some v ->
        let keyPolygon = v.polygon
        tree.strTree.Query(keyPolygon.EnvelopeInternal)
        |> Seq.filter (fun item -> item.key <> key)
        |> Seq.filter (fun item -> keyPolygon.Intersects(item.polygon))
        |> Seq.map (fun elem -> elem.data)
        |> Seq.toList

  /// Returns items whose polygons contain the given point.
  let queryContainingPoint (point: Coordinate) (tree: STRtree<_, _>) =
    tree.strTree.Query(Envelope point)
    |> Seq.where (fun elem -> isPointInPolygon point elem.polygon)
    |> Seq.map (fun elem -> elem.data)
    |> Seq.toList
InternalElement.key: 'Key
InternalElement.data: 'Value
InternalElement.polygon: obj
Multiple items
type StructAttribute =
  inherit Attribute
  new : unit -> StructAttribute

--------------------
new : unit -> StructAttribute
[<Struct>]
type STRtree<'Key,'Value (requires comparison)> =
  private { map: Map<'Key,InternalElement<'Key,'Value>>
            strTree: obj }
STRtree.map: Map<'Key,InternalElement<'Key,'Value>>
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IReadOnlyDictionary<'Key,'Value>
  interface IReadOnlyCollection<KeyValuePair<'Key,'Value>>
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  ...

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
type private InternalElement<'Key,'Value (requires comparison)> =
  { key: 'Key
    data: 'Value
    polygon: obj }
STRtree.strTree: obj
Multiple items
type RequireQualifiedAccessAttribute =
  inherit Attribute
  new : unit -> RequireQualifiedAccessAttribute

--------------------
new : unit -> RequireQualifiedAccessAttribute
Multiple items
module STRtree

from Script

--------------------
[<Struct>]
type STRtree<'Key,'Value (requires comparison)> =
  private { map: Map<'Key,InternalElement<'Key,'Value>>
            strTree: obj }
Multiple items
type AutoOpenAttribute =
  inherit Attribute
  new : unit -> AutoOpenAttribute
  new : path:string -> AutoOpenAttribute
  member Path : string

--------------------
new : unit -> AutoOpenAttribute
new : path:string -> AutoOpenAttribute
val private isPointInPolygon : testPoint:'a -> polygon:'b -> bool


 Tests where a point is contained is polygon.
 Adapted from https://corstianboerman.com/posts/2018-10-08/retrieving-all-polygons-that-overlap-a-single-point.html
val testPoint : 'a
val polygon : 'b
val polygon : obj
val mutable result : bool
val mutable j : int
val i : int
val not : value:bool -> bool
val private createInternalElem : 'Key * 'Value * 'a -> InternalElement<'Key,'Value> (requires comparison)
val entity : 'Key * 'Value * 'a (requires comparison)
val key : 'Key (requires comparison)
val element : 'Value
val geom : 'a
val private createEmptyTree : unit -> 'a
Multiple items
type GeneralizableValueAttribute =
  inherit Attribute
  new : unit -> GeneralizableValueAttribute

--------------------
new : unit -> GeneralizableValueAttribute
val empty<'Key,'Value (requires comparison)> : STRtree<'Key,'Value> (requires comparison)


 an empty type
val tree : obj
val empty<'Key,'T (requires comparison)> : Map<'Key,'T> (requires comparison)
val ofSeq : entities:seq<'Key * 'Value * 'a> -> STRtree<'Key,'Value> (requires comparison)


 Constructs the tree from sequence of value and their geometries
val entities : seq<'Key * 'Value * 'a> (requires comparison)
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

--------------------
type seq<'T> = System.Collections.Generic.IEnumerable<'T>
val map : Map<'Key,InternalElement<'Key,'Value>> (requires comparison)
module Array

from Microsoft.FSharp.Collections
val ofSeq : source:seq<'T> -> 'T []
val map : mapping:('T -> 'U) -> array:'T [] -> 'U []
val elem : InternalElement<'Key,'Value> (requires comparison)
val ofSeq : elements:seq<'Key * 'T> -> Map<'Key,'T> (requires comparison)
val _values : seq<InternalElement<System.IComparable,obj>>
val p : InternalElement<System.IComparable,obj>
val envelope : obj
val queryEnvelope : envelope:'a -> tree:STRtree<'b,'c> -> 'd list (requires comparison)


 Returns items whose polygons intersect the given envelope
val envelope : 'a
[<Struct>]
val tree : STRtree<'b,'c> (requires comparison)
module Seq

from Microsoft.FSharp.Collections
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>
val elem : InternalElement<System.IComparable,'d>
InternalElement.data: 'd
val toList : source:seq<'T> -> 'T list
val queryGeometry : geometry:'a -> tree:STRtree<'b,'c> -> 'd list (requires comparison)


 Returns items whose polygons intersect the given geometry
val geometry : 'a
val filter : predicate:('T -> bool) -> source:seq<'T> -> seq<'T>
val item : InternalElement<System.IComparable,'d>
val neighbours : key:'Key -> tree:STRtree<'Key,'a> -> 'b list (requires comparison)


 Returns items whose polygons intersect geometry of the given key
[<Struct>]
val tree : STRtree<'Key,'a> (requires comparison)
STRtree.map: Map<'Key,InternalElement<'Key,'a>>
member Map.TryFind : key:'Key -> 'Value option
union case Option.None: Option<'T>
union case Option.Some: Value: 'T -> Option<'T>
val v : InternalElement<'Key,'a> (requires comparison)
val keyPolygon : obj
val item : InternalElement<'Key,'b> (requires comparison)
val elem : InternalElement<'Key,'b> (requires comparison)
InternalElement.data: 'b
val queryContainingPoint : point:'a -> tree:STRtree<'b,'c> -> 'd list (requires comparison)


 Returns items whose polygons contain the given point.
val point : 'a
val where : predicate:('T -> bool) -> source:seq<'T> -> seq<'T>
Raw view Test code New version

More information

Link:http://fssnip.net/7Zs
Posted:3 years ago
Author:Swoorup Joshi
Tags: spatial , #strtree , #nettopologysuite