type private InternalElement<'Key, 'Value when 'Key: comparison> = { key: 'Key data: 'Value polygon: Polygon } [] type STRtree<'Key, 'Value when 'Key: comparison> = private { map: Map<'Key, InternalElement<'Key, 'Value>> strTree: NetTopologySuite.Index.Strtree.STRtree> } [] module STRtree = [] 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>() /// an empty type [] 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