Permalink
Browse files

written red-black insert and parts of delete but disabled

  • Loading branch information...
1 parent a304e05 commit d4dd07592ea84384074497c67fe431ccffe2812e @sake committed Feb 10, 2010
Showing with 342 additions and 91 deletions.
  1. +2 −1 cl-treemaps.asd
  2. +78 −77 src/binary.lisp
  3. +7 −13 src/interface.lisp
  4. +255 −0 src/redblack.lisp
View
@@ -38,7 +38,8 @@
:components
((:file "package")
(:file "interface")
- (:file "binary")))))
+ (:file "binary")
+ (:file "redblack")))))
;; method to call tests
View
@@ -1,90 +1,91 @@
-;;; cl-treemaps - Common LISP binary trees
-;;; Copyright (C) 2010 Tobias Wich <tobias.wich@electrologic.org>
-;;;
-;;; This library is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU Lesser General Public
-;;; License as published by the Free Software Foundation; either
-;;; version 2.1 of the License, or (at your option) any later version.
-;;;
-;;; This library is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; Lesser General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with this library; if not, write to the Free Software
-;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;; ;;; cl-treemaps - Common LISP binary trees
+;; ;;; Copyright (C) 2010 Tobias Wich <tobias.wich@electrologic.org>
+;; ;;;
+;; ;;; This library is free software; you can redistribute it and/or
+;; ;;; modify it under the terms of the GNU Lesser General Public
+;; ;;; License as published by the Free Software Foundation; either
+;; ;;; version 2.1 of the License, or (at your option) any later version.
+;; ;;;
+;; ;;; This library is distributed in the hope that it will be useful,
+;; ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; ;;; Lesser General Public License for more details.
+;; ;;;
+;; ;;; You should have received a copy of the GNU Lesser General Public
+;; ;;; License along with this library; if not, write to the Free Software
+;; ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-(in-package :cl-treemaps)
+;; (in-package :cl-treemaps)
-(defclass binary-tree-map (tree-map)
- ((data :accessor data :initform nil)
- (testfun :accessor testfun :initarg :testfun :initform (error "No test function specified.")))
- (:documentation "Binary tree implementation."))
+;; (defclass binary-tree-map (tree-map)
+;; ((data :accessor data :initform nil)
+;; (testfun :accessor testfun :initarg :testfun :initform (error "No test function specified.")))
+;; (:documentation "Binary tree implementation."))
-(defmethod make-tree-intern ((test function) (type (eql :binary)))
- (let (tree)
- (setf tree (make-instance 'binary-tree-map :testfun test))))
+;; (defmethod make-tree-intern ((test function) (type (eql :binary)))
+;; (let (tree)
+;; (setf tree (make-instance 'binary-tree-map :testfun test))))
-(defmethod clr-tree ((tree binary-tree-map))
- (setf (data tree) nil))
+;; (defmethod clr-tree ((tree binary-tree-map))
+;; (setf (data tree) nil)
+;; tree)
-(defmethod get-tree-entry ((tree binary-tree-map) key)
- ;; do normal search
- (labels ((local-find (node)
- (if (not node)
- ;; node not existant
- (values nil nil)
- (let ((stored-key (first node)))
- (cond
- ;; stored-key = key
- ((not (or (compare tree key stored-key) (compare tree stored-key key)))
- (values (second node) t))
- ;; left path
- ((compare tree key stored-key)
- (local-find (third node)))
- ;; right path
- ((compare tree stored-key key)
- (local-find (fourth node))))))))
- ;; call find method
- (local-find (data tree))))
+;; (defmethod get-tree-entry ((tree binary-tree-map) key)
+;; ;; do normal search
+;; (labels ((local-find (node)
+;; (if (not node)
+;; ;; node not existant
+;; (values nil nil)
+;; (let ((stored-key (first node)))
+;; (cond
+;; ;; stored-key = key
+;; ((not (or (compare tree key stored-key) (compare tree stored-key key)))
+;; (values (second node) t))
+;; ;; left path
+;; ((compare tree key stored-key)
+;; (local-find (third node)))
+;; ;; right path
+;; ((compare tree stored-key key)
+;; (local-find (fourth node))))))))
+;; ;; call find method
+;; (local-find (data tree))))
-(defmethod update-tree-entry ((tree binary-tree-map) key value)
- (let ((cmp (testfun tree)))
- ;; do normal search
- (labels ((local-insert (node parent direction)
- (if (not node)
- ;; node not existant, create and insert
- (let ((new-node (list key value nil nil)))
- (cond ((not parent) ; tree is empty
- (setf (data tree) new-node))
- ((eq direction 'left) ;; set left parent reference
- (setf (third parent) new-node))
- ((eq direction 'right) ;; set right parent reference
- (setf (fourth parent) new-node)))
- value)
- ;; search in the tree
- (let ((stored-key (first node)))
- (cond
- ;; stored-key = key
- ((not (or (funcall cmp key stored-key) (funcall cmp stored-key key)))
- ;; update value
- (setf (second node) value)
- value)
- ;; left path
- ((funcall cmp key stored-key)
- (local-insert (third node) node 'left))
- ;; right path
- ((funcall cmp stored-key key)
- (local-insert (fourth node) node 'right)))))))
- ;; call find method
- (values (local-insert (data tree) nil nil) t))))
+;; (defmethod update-tree-entry ((tree binary-tree-map) key value)
+;; (let ((cmp (testfun tree)))
+;; ;; do normal search
+;; (labels ((local-insert (node parent direction)
+;; (if (not node)
+;; ;; node not existant, create and insert
+;; (let ((new-node (list key value nil nil)))
+;; (cond ((not parent) ; tree is empty
+;; (setf (data tree) new-node))
+;; ((eq direction 'left) ;; set left parent reference
+;; (setf (third parent) new-node))
+;; ((eq direction 'right) ;; set right parent reference
+;; (setf (fourth parent) new-node)))
+;; value)
+;; ;; search in the tree
+;; (let ((stored-key (first node)))
+;; (cond
+;; ;; stored-key = key
+;; ((not (or (funcall cmp key stored-key) (funcall cmp stored-key key)))
+;; ;; update value
+;; (setf (second node) value)
+;; value)
+;; ;; left path
+;; ((funcall cmp key stored-key)
+;; (local-insert (third node) node 'left))
+;; ;; right path
+;; ((funcall cmp stored-key key)
+;; (local-insert (fourth node) node 'right)))))))
+;; ;; call find method
+;; (values (local-insert (data tree) nil nil) t))))
-(defmethod compare ((tree binary-tree-map) a b)
- (funcall (testfun tree) a b))
+;; (defmethod compare ((tree binary-tree-map) a b)
+;; (funcall (testfun tree) a b))
View
@@ -27,19 +27,19 @@
;;; public interface functions
;;;
-(defun make-tree (&key (test #'<) (type :binary))
+(defun make-tree (&key (test #'<) (type :red-black))
(make-tree-intern test type))
-(defgeneric get-tree-entry (tree key)
- (:documentation ""))
+(defgeneric clr-tree (tree)
+ (:documentation "Remove all elements from a tree."))
+
+(defgeneric get-tree-entry (tree key &optional value)
+ (:documentation "Get the value for a given key, or insert/update if a value is supplied."))
(defgeneric del-tree-entry (tree key)
(:documentation "Remove a single element specified by key from a tree."))
-(defgeneric clr-tree (tree)
- (:documentation "Remove all elements from a tree."))
-
-(defsetf get-tree-entry update-tree-entry)
+(defsetf get-tree-entry get-tree-entry)
;;;
@@ -48,9 +48,3 @@
(defgeneric make-tree-intern (test type)
(:documentation "Create a new tree map."))
-
-(defgeneric update-tree-entry (tree key value)
- (:documentation "Insert a new key value pair into the tree."))
-
-(defgeneric compare (tree a b)
- (:documentation "Compare element a and b with the tree's test function."))
Oops, something went wrong.

0 comments on commit d4dd075

Please sign in to comment.