Permalink
Browse files

added split and merge functions to red black trees

  • Loading branch information...
1 parent a8c53c6 commit 249efe95b39b23a2b6ba462e583b65e33a398437 @sake committed Feb 17, 2010
Showing with 71 additions and 2 deletions.
  1. +1 −0 cl-treemaps.asd
  2. +7 −0 src/interface.lisp
  3. +4 −2 src/package.lisp
  4. +40 −0 src/redblack.lisp
  5. +19 −0 test/testcases.lisp
View
@@ -40,4 +40,5 @@
;; method to call tests
(defmethod perform ((o test-op) (c (eql (find-system 'cl-treemaps))))
+ (operate 'load-op 'cl-treemaps)
(operate 'test-op 'cl-treemaps-test))
View
@@ -41,6 +41,13 @@
(defsetf get-tree-entry get-tree-entry)
+(defgeneric split-tree (tree index)
+ (:documentation "Split a tree into two new trees. Index is a number that describes the index of the split
+node when the tree is seen as a list. The node corresponding to index is included in the second tree."))
+
+(defgeneric merge-trees (first second)
+ (:documentation "Merge the second tree into the first."))
+
;;;
;;; internal functions
View
@@ -23,5 +23,7 @@
(:use :cl)
;; tree classes
(:export tree-map redblack-tree-map)
- ;; tree operations
- (:export make-tree get-tree-entry del-tree-entry clr-tree))
+ ;; basic tree operations
+ (:export make-tree get-tree-entry del-tree-entry clr-tree)
+ ;; split and merge
+ (:export split-tree merge-trees))
View
@@ -324,6 +324,46 @@
+(defmethod split-tree ((tree redblack-tree-map) index)
+ (let ((left-tree (make-tree :test (testfun tree) :type :red-black))
+ (right-tree (make-tree :test (testfun tree) :type :red-black))
+ (i 0))
+ ;; function to do the iteration stuff
+ (labels ((recurse-node (node)
+ (if node
+ (progn
+ ;; recurse to the left
+ (recurse-node (rb-left node))
+ ;; add node to relating new tree
+ (setf (get-tree-entry
+ (if (< i index)
+ left-tree
+ right-tree)
+ (rb-key node)) (rb-value node))
+ (incf i) ; increment counter
+ ;; recurse to the right
+ (recurse-node (rb-right node))))))
+ ;; perform split
+ (recurse-node (data tree)))
+ (list left-tree right-tree)))
+
+
+(defmethod merge-trees ((first redblack-tree-map) (second redblack-tree-map))
+ ;; function to do the iteration stuff
+ (labels ((recurse-node (node)
+ (if node
+ (progn
+ ;; recurse to the left
+ (recurse-node (rb-left node))
+ ;; add/update node in the first tree
+ (setf (get-tree-entry first (rb-key node)) (rb-value node))
+ ;; recurse to the right
+ (recurse-node (rb-right node))))))
+ (recurse-node (data second)))
+ first)
+
+
+
;;;
;;; test helpers
;;;
View
@@ -52,3 +52,22 @@
(is (not (zerop (cl-treemaps::rb-assert tree))))))
;; final check if tree is empty
(is (not (cl-treemaps::data tree)))))))
+
+(test split-merge-tree
+ (let ((tree (make-tree :type :red-black))) ;; nothing can go wrong here
+ ;; insert values into tree
+ (loop for i from 0 to 1000 do
+ (setf (get-tree-entry tree i) i))
+ (let (tree-list)
+ ;; split tree into equal sized halfs
+ (setf tree-list (split-tree tree 500))
+ ;; check if every half contains the correct elements
+ (loop for i from 0 to 499 do
+ (is (= i (get-tree-entry (first tree-list) i) i)))
+ (loop for i from 500 to 999 do
+ (is (= i (get-tree-entry (second tree-list) i) i)))
+ ;; merge all entries from second tree into first
+ (merge-trees (first tree-list) (second tree-list))
+ ;; test if all elements are now in first tree
+ (loop for i from 0 to 1000 do
+ (is (= i (get-tree-entry (first tree-list) i) i))))))

0 comments on commit 249efe9

Please sign in to comment.