/
mem_tree.clj
111 lines (93 loc) · 3.7 KB
/
mem_tree.clj
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
(ns mem-tree
(:use [datomic.api :only (q db) :as d]
quil.core)
(:require [meridian.datomic-rtree.test-utils :as utils]
[meridian.datomic-rtree.rtree :as rtree]
[meridian.datomic-rtree.bbox :as bbox]
[meridian.datomic-rtree.bulk :as bulk])
(:import datomic.Util))
(def uri "datomic:mem://rtrees")
(defn print-tree [conn]
(let [root (:rtree/root (utils/find-tree (d/db conn)))]
((fn walk [n indent]
(println (str indent (:db/id n) " " (:node/entry n)))
(doseq [c (:node/children n)]
(walk c (str indent "---"))))
root "")))
(defn install-and-print-tree [conn num-entries]
(utils/install-rand-data conn num-entries utils/create-feature)
(print-tree conn))
(defn all-entries [db]
(map #(d/entity db (first %))
(d/q '[:find ?e :where [?e :node/entry]] db)))
(defn naive-intersecting [entries search-box]
(into [] (filter #(bbox/intersects? search-box %) entries)))
(defn ent-intersects? [box ent db]
(bbox/intersects? box (d/entity db ent)))
(def search-rules
'[[(intersecting ?ancestor ?descendant ?search-box)
[(mem-tree/ent-intersects? ?search-box ?descendant $)]
[?ancestor :node/children ?descendant]]
[(intersecting ?ancestor ?descendant ?search-box)
[?ancestor :node/children ?child]
[intersecting ?child ?descendant ?search-box]]])
(def intersecting-q
'[:find ?e
:in $ % ?root ?bbox
:where
[intersecting ?root ?e ?bbox]
[?e :node/entry]])
(comment
(def conn (utils/create-and-connect-db uri
"resources/datomic/schema.edn"
"resources/datomic/geojsonschema.edn"))
(utils/install-rand-data conn 1000 utils/create-feature)
(utils/install-rand-ents conn 1000 utils/create-feature)
(utils/create-tree-and-install-rand-data conn 40 6 3)
(def search-box (bbox/extents 0.0 0.0 10.0 10.0))
(def root (:rtree/root (find-tree (d/db conn))))
(time (count (naive-intersecting (all-entries (d/db conn)) search-box)))
(time (count (rtree/intersecting root search-box)))
(time (count (d/q intersecting-q (d/db conn) search-rules (:db/id root) search-box)))
(time (utils/install-and-bulk-load conn 10000 6 3))
)
;;;;;; draw tree with quill ;;;;;;
(defn all-bbox [db]
(map #(d/entity db (first %))
(d/q '[:find ?e :where [?e :bbox/min-x]] db)))
(defn key-press []
(let [conn (state :conn)]
(install-and-print-tree conn 1)
(reset! (state :rects) (all-bbox (d/db conn)))))
(defn setup-sketch []
(frame-rate 30)
(smooth)
(let [conn (utils/create-and-connect-db uri
"resources/datomic/schema.edn"
"resources/datomic/geojsonschema.edn")]
#_(do (utils/install-rand-ents conn 30 utils/create-feature)
(utils/bulk-load-ents conn 6 3 bulk/dyn-cost-partition))
(do (utils/create-tree conn 6 3)
(utils/install-rand-ents conn 1 utils/create-feature)
(utils/load-ents conn 6 3))
(set-state! :conn conn
:rects (atom (all-bbox (d/db conn))))))
(defn draw-sketch []
(stroke 255)
(fill 255)
(rect 0 0 600 600)
(doseq [r (sort-by :node/is-leaf? @(state :rects))]
(no-fill)
(stroke-weight 1)
(cond
(:node/entry r) (do (stroke-weight 2) (stroke 0 0 256))
(:node/is-leaf? r) (do (stroke-weight 2) (stroke 256 0 0))
:else (do (stroke-weight 2) (stroke 20 180 200)))
(rect (:bbox/min-x r) (:bbox/min-y r)
(- (:bbox/max-x r) (:bbox/min-x r)) (- (:bbox/max-y r) (:bbox/min-y r)))))
(defn tree-sketch []
(sketch :title "R-tree"
:setup setup-sketch
:draw draw-sketch
:key-typed key-press
:size [600 600]))