Something went wrong. Try again.
R-tree spatial index, in pure OCaml
Something went wrong. Try again.
2.6 kB · 79 lines
OCaml
at main
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980open! Import
type t = floatarray
let dimensions = 2let x0 arr = Array.Floatarray.unsafe_get arr 0let x1 arr = Array.Floatarray.unsafe_get arr 1let y0 arr = Array.Floatarray.unsafe_get arr 2let y1 arr = Array.Floatarray.unsafe_get arr 3
let compare_dim i arr arr' = match i with | 0 -> Float.compare (x0 arr) (x0 arr') | 1 -> Float.compare (y0 arr) (y0 arr') | n -> invalid_arg ("Only two dimensions and you accessed " ^ string_of_int n)
let coords arr = ( Array.Floatarray.unsafe_get arr 0, Array.Floatarray.unsafe_get arr 1, Array.Floatarray.unsafe_get arr 2, Array.Floatarray.unsafe_get arr 3 )
let v ~x0 ~y0 ~x1 ~y1 = if x0 > x1 then invalid_arg "x0 should be less than or equal to x1"; if y0 > y1 then invalid_arg "y0 should be less than or equal to y1"; let arr = Array.Floatarray.create 4 in Array.Floatarray.unsafe_set arr 0 x0; Array.Floatarray.unsafe_set arr 1 x1; Array.Floatarray.unsafe_set arr 2 y0; Array.Floatarray.unsafe_set arr 3 y1; arr
let ranges_intersect a b a' b' = Float.compare a' b <= 0 && Float.compare a b' <= 0
let intersects arr arr' = let x0, x0' = (x0 arr, x0 arr') in let x1, x1' = (x1 arr, x1 arr') in let y0, y0' = (y0 arr, y0 arr') in let y1, y1' = (y1 arr, y1 arr') in ranges_intersect x0 x1 x0' x1' && ranges_intersect y0 y1 y0' y1'
let merge arr arr' = let x0, x0' = (x0 arr, x0 arr') in let x1, x1' = (x1 arr, x1 arr') in let y0, y0' = (y0 arr, y0 arr') in let y1, y1' = (y1 arr, y1 arr') in let arr = Array.Floatarray.create 4 in Array.Floatarray.unsafe_set arr 0 (min x0 x0'); Array.Floatarray.unsafe_set arr 1 (max x1 x1'); Array.Floatarray.unsafe_set arr 2 (min y0 y0'); Array.Floatarray.unsafe_set arr 3 (max y1 y1'); arr
(* The identity for [merge]: its bounds are inverted so that a merge takes the other rectangle's bounds whole, and [v] refuses to build another. *)let empty = let arr = Array.Floatarray.create 4 in Array.Floatarray.unsafe_set arr 0 infinity; Array.Floatarray.unsafe_set arr 1 neg_infinity; Array.Floatarray.unsafe_set arr 2 infinity; Array.Floatarray.unsafe_set arr 3 neg_infinity; arr
let merge_many t = List.fold_left merge empty t
let area arr = let x0, x1, y0, y1 = (x0 arr, x1 arr, y0 arr, y1 arr) in if x1 < x0 || y1 < y0 then 0. else (x1 -. x0) *. (y1 -. y0)
let contains arr arr' = let x0, x0' = (x0 arr, x0 arr') in let x1, x1' = (x1 arr, x1 arr') in let y0, y0' = (y0 arr, y0 arr') in let y1, y1' = (y1 arr, y1 arr') in Float.compare x0 x0' <= 0 && Float.compare x1 x1' >= 0 && Float.compare y0 y0' <= 0 && Float.compare y1 y1' >= 0