Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

added iterator makro and test

  • Loading branch information...
commit 6de117156f4ee3c73f6d7a626a0290b3d33809a4 1 parent 888300f
@sake authored
View
11 src/interface.lisp
@@ -55,6 +55,14 @@ node when the tree is seen as a list. The node corresponding to index is include
(defgeneric merge-trees (first second)
(:documentation "Merge the second tree into the first."))
+(defmacro with-treemap-iterator ((iterator treemap) &body body)
+ (let ((iter-fun (gensym)))
+ `(let ((,iter-fun (tree-iterator-fun ,treemap)))
+ ;; macrolet to inject iterator into body
+ (macrolet ((,iterator ()
+ '(funcall ,iter-fun)))
+ ,@body))))
+
;;;
;;; internal functions
@@ -65,3 +73,6 @@ node when the tree is seen as a list. The node corresponding to index is include
(defgeneric tree-dot (tree file)
(:documentation "Serialise tree as dot file (graphviz)."))
+
+(defgeneric tree-iterator-fun (tree)
+ (:documentation "Internal method to generate an interator function for this tree."))
View
4 src/package.lisp
@@ -26,4 +26,6 @@
;; basic tree operations
(:export make-tree get-tree-entry del-tree-entry clr-tree treemap-count map-tree)
;; split and merge
- (:export split-tree merge-trees))
+ (:export split-tree merge-trees)
+ ;; iterator
+ (:export with-treemap-iterator))
View
59 src/redblack.lisp
@@ -128,6 +128,65 @@
nil)
+;;;
+;;; iterator stuff
+;;;
+
+(defmethod tree-iterator-fun ((treemap redblack-tree-map))
+ (let ((iter-fun
+ (let ((path nil)
+ (op-path nil)
+ (value-found nil)
+ (result nil)
+ (done-p nil))
+ (labels
+ ((iter-fun-intern1 ()
+ ;; prepare next iteration
+ (setf value-found nil)
+ (if (or done-p (not (data treemap)))
+ nil
+ (progn
+ ;; call function which depends on node
+ (iter-fun-intern2)
+ (if done-p
+ nil
+ (values-list result)))))
+
+ (iter-fun-intern2 ()
+ (if (not path)
+ ;; add root node if no other path present
+ (progn
+ (setf path (list (data treemap)))
+ (setf op-path (list 'down-left)))
+ ;; decide what to do next
+ (cond ((eq (first op-path) 'down-left) ; last node had down-left
+ (cond ((rb-left (first path)) ; left child in node
+ ;; set current to left otherwise it is processed again as a left-down
+ (setf (first op-path) 'left)
+ ;; add child to list
+ (setf path (append (list (rb-left (first path))) path))
+ (setf op-path (append (list 'down-left) op-path)))
+ (t ; no left child process this one
+ (setf (first op-path) 'left))))
+ ((eq (first op-path) 'left) ; node is next
+ (setf result (list t (rb-key (first path)) (rb-value (first path))))
+ (setf value-found t)
+ (setf (first op-path) 'up) ; move up after going back here
+ (cond ((rb-right (first path)) ; right node present go down
+ (setf path (append (list (rb-right (first path))) path))
+ (setf op-path (append (list 'down-left) op-path)))))
+ ((eq (first op-path) 'up) ; node is done delete
+ (setf path (rest path))
+ (setf op-path (rest op-path))
+ ;; if path is empty we are done
+ (if (not path)
+ (setf done-p t)))))
+ ;; recurse if no value has been found and not done
+ (if (and (not done-p) (not value-found))
+ (iter-fun-intern2))))
+
+ #'iter-fun-intern1))))
+ iter-fun))
;;;
View
14 test/testcases.lisp
@@ -86,3 +86,17 @@
(is (= (treemap-count tree) (1+ i)))
(del-tree-entry tree i)
(is (= (treemap-count tree) i))))))
+
+(test tree-iterator
+ (let ((tree (make-tree :type :red-black))) ;; nothing can go wrong here
+ ;; insert values into tree
+ (loop for i from 0 to 100 do
+ (progn
+ (is (= (treemap-count tree) i))
+ (setf (get-tree-entry tree i) i)
+ (is (= (treemap-count tree) (1+ i)))))
+ (with-treemap-iterator (iter tree)
+ (loop for i from 0 to 100 do
+ (multiple-value-bind (a b c) (iter)
+ (declare (ignore a c))
+ (is (= i b)))))))
Please sign in to comment.
Something went wrong with that request. Please try again.