Permalink
Browse files

first part of binary tree

  • Loading branch information...
sake committed Feb 8, 2010
1 parent de3be06 commit a304e05e803b21a75a88d9258c0d859d8083819a
View
@@ -0,0 +1 @@
+*.fasl
File renamed without changes.
View
@@ -22,6 +22,7 @@
(in-package :cl-treemaps-system)
+
(defsystem cl-treemaps
:name "cl-treemaps"
:description "Common Lisp binary trees"
@@ -37,7 +38,7 @@
:components
((:file "package")
(:file "interface")
- (:file "red-black")))))
+ (:file "binary")))))
;; method to call tests
View
@@ -0,0 +1,90 @@
+;;; 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)
+
+
+(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 clr-tree ((tree binary-tree-map))
+ (setf (data tree) nil))
+
+
+(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 compare ((tree binary-tree-map) a b)
+ (funcall (testfun tree) a b))
View
@@ -17,14 +17,40 @@
(in-package :cl-treemaps)
-(defgeneric make-tree ()
- (:documentation ""))
-(defgeneric get-tree-entry ()
- (:documentation ""))
+(defclass tree-map ()
+ ()
+ (:documentation "Base class for a tree map."))
-(defgeneric del-tree-entry ()
- (:documentation ""))
-(defgeneric clr-tree ()
+;;;
+;;; public interface functions
+;;;
+
+(defun make-tree (&key (test #'<) (type :binary))
+ (make-tree-intern test type))
+
+(defgeneric get-tree-entry (tree key)
(:documentation ""))
+
+(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)
+
+
+;;;
+;;; internal functions
+;;;
+
+(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."))
View
@@ -18,7 +18,7 @@
(in-package :cl-user)
-(defpackage clon-db
+(defpackage cl-treemaps
(:documentation "Common Lisp binary trees")
(:use :cl)
;; tree operations
View
@@ -15,7 +15,7 @@
;;; 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 :clon-test)
+(in-package :cl-treemaps-test)
(defun run-all-suites ()
View
@@ -15,4 +15,4 @@
;;; 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 :clon-test)
+(in-package :cl-treemaps-test)

0 comments on commit a304e05

Please sign in to comment.