quadtree.clj

(ns sherpa.client.quad-tree
  (:refer-clojure :exclude [node children])
  (:use [sherpa.client.util :only [log uuid]]))


; ;========================================================================================
; ; Node
; ;========================================================================================

(def TOP_LEFT 0)
(def TOP_RIGHT 1)
(def BOTTOM_RIGHT 2)
(def BOTTOM_LEFT 3)

(defn bounds
  [x y w h]
  {:x x :y y :width w :height h})

(defn node
	[& opts]
	(merge
    {:id             (uuid)
  	 :bounds         {:x nil :y nil :width nil :height nil}
  	 :children       '()
     :stuck-children '()
  	 :nodes          '()
  	 :max-depth      4
  	 :max-children   4
  	 :depth          0}
     opts))

(defn bounds-node [& opts]
  (node opts))

(defn get-node
	[tree node-id]
	(get-in tree [:nodes node-id]))

(defn add-node
	[tree n]
	(assoc-in tree [:nodes (:id n)] n))

(defn find-index
  [n item]
  (let [b (:bounds n)
        left? (if (> (:x item) (+ (:x b) (:width b)))
                false
                true)
        top? (if (> (:y item) (+ (:y b) (:height b)))
                false
                true)]
    (if left?
      (if top?
        TOP_LEFT
        BOTTOM_LEFT)
      (if top?
        TOP_RIGHT
        BOTTOM_RIGHT))))

(defn subdivide
  [n]
  (let [depth    (+ (:depth n) 1)
        bounds   (:bounds n)
        bx       (:x bounds)
        by       (:y bounds)
        b-w-h    (or (/ (:width bounds) 2) 0)
        b-h-h    (or (/ (:height bounds) 2) 0)
        bx-b-w-h (+ bx b-w-h)
        by-b-h-h (+ by b-h-h)
        nodes [(bounds-node {:bounds {:x bx :y by :width b-w-h :height b-h-h}})
               (bounds-node {:bounds {:x bx-b-w-h :y by :width b-w-h :height b-h-h}})
               (bounds-node {:bounds {:x bx :y by-b-h-h :width b-w-h :height b-h-h}})
               (bounds-node {:bounds {:x bx-b-w-h :y by-b-h-h :width b-w-h :height b-h-h}})]]
    (assoc n :nodes nodes)))

(defn insert-items
  [node insert-fn items]
  (do
    (map (partial insert-fn node) items)))

(defn node-insert
	[node item]
  (println "start " node)
	(let [nodes  (:nodes node)]
		(if (empty? nodes)
      ; if this node has NO sub nodes, add the new item to children.
      ; Check if there are more than max-children. If so, subdivide this node and insert into the children
      (do
        (let [children (conj (:children node) item)
              node-with-item (assoc node :children children)
              child-count (count (:children node-with-item))
              subdivide? (and
                            (not (>= (:depth node) (:max-depth node)))
                            (> child-count (:max-children node)))]
        (if subdivide?
          (let [divided-node (subdivide node-with-item)]
            (println divided-node)
            (insert-items divided-node node-insert (:children divided-node)))
          (do
            (println "just add to children and return")
            (println node)
            (println (:children node))
            (println children)
            (println node-with-item)
            (assoc node :children children)))))
      ; else if this node has sub nodes, find which node the new item
      ; will be inserted into and call recursive insert.
      (do
        (println "nodes not empty")
        (let [idx             (find-index node item)
              _ (println "idx = " idx)
              idx-node        (get nodes idx)
              _ (println "idx-node = " idx-node)
              bounds          (:bounds idx-node)
              item-bounds     (:bounds item)
              in-from-left?   (>= (:x bounds) (:x item-bounds))
              in-from-right?  (<= (+ (:x item-bounds) (:width item-bounds)) (+ (:x bounds) (:width bounds)))
              in-from-top?    (>= (:y item-bounds) (:y bounds))
              in-from-bottom? (<= (+ (:y item-bounds) (:height item-bounds)) (+ (:y bounds) (:height bounds)))
              item-in-bounds? (and in-from-left? in-from-right? in-from-top? in-from-bottom?)]
          (if item-in-bounds?
            (do
              (println "item in bounds")
              (println node)
              (println idx-node)
              (let [children (conj (:children node) item)
                    node-with-item (assoc node :children children)
                    child-count (count (:children node-with-item))
                    subdivide? (and
                                  (not (>= (:depth node) (:max-depth node)))
                                  (> child-count (:max-children node)))]
                ()    )

              )
            (let [stuck-children (conj (:stuck-children node) item)]
              ; else add to stuck-children (children not all the way in bounds but touching).
              (assoc node :stuck-children stuck-children))))))))


(do
  (def tree (quad-tree {:x 0 :y 0 :width 1000 :height 600} 8 4))
  (def tree (tree-insert tree {:bounds {:x 0 :y 0 :width 50 :height 50}}))
  (def tree (tree-insert tree {:bounds {:x 200 :y 200 :width 50 :height 50}}))
  (def tree (tree-insert tree {:bounds {:x 210 :y 200 :width 50 :height 50}}))
  (def tree (tree-insert tree {:bounds {:x 210 :y 200 :width 50 :height 50}}))
  (def tree (tree-insert tree {:bounds {:x 210 :y 200 :width 50 :height 50}}))
  (def tree (tree-insert tree {:bounds {:x 210 :y 200 :width 50 :height 50}})))


;========================================================================================
; Tree
;========================================================================================

(defn clear [tree] (assoc tree :root nil))

; (defn tree-retrieve
; 	[tree item]
; 	(retrieve-from-node tree item))

(defn tree-insert
"Insert one or more nodes."
	[tree item]
  (node-insert tree item))

(defn quad-tree
"QuadTree data structure.
@param {Object} An object representing the bounds of the top level of the QuadTree. The object
should contain the following properties : x, y, width, height
@param {Boolean} pointQuad Whether the QuadTree will contain points (true), or items with bounds
(width / height)(false). Default value is false.
@param {Number} maxDepth The maximum number of levels that the quadtree will create. Default is 4.
@param {Number} maxChildren The maximum number of children that a node can contain before it is split into sub-nodes."
[bounds max-depth max-children]
	(let [root-node (bounds-node {:bounds bounds :depth 0 :max-depth max-depth :max-children max-children})]
		root-node))