From: ·········@hotmail.com
Subject: Yet another red-black tree implementation.
Date: 
Message-ID: <558aa57f-e9aa-4ae1-b68b-081973100479@s9g2000prg.googlegroups.com>
Hi,

I needed a red-black tree implementation for a side project I am
doing. I originally tried to get Robert Sedgewick's left leaning red
black tree algorithm running in Lisp but ran into troubles with
delete. I had no such problems with porting Julienne Walker's,
http://eternallyconfuzzled.com, C version. It also doesn't use parent
pointers and is quite compact.

It is about 700 lines long which is probably to long to post on this
news group but I couldn't think of anywhere else it should go.

Regards,

Matthew

;;
==================================================================================
;; Lisp implementation of the Eternally Confuzzled, Julienne Walker's
Red Black tree.
;;
;; Ported by Matthew O'Connor
;;
;; I ported this from the C version of the code availble on the
Eternally Confuzzled
;; web site, http://eternallyconfuzzled.com . It implements both top-
down deletion
;; and insertion. The algorithm is used as part of the goolge-web-
toolkit (GWT) to make
;; their TreeMap.
;;
;; I am using it as part of another project and thought that other
people might find
;; it useful.

(defpackage :rbtree
  (:export new-tree
           find
           insert
           erase

           iterator
           first
           last
           next
           prev

           free

           dump)

  (:shadow find
           first
           last))

(in-package :rbtree)

;; A node of the red-black tree.
(defstruct rbnode
  ;; @field red:boolean - The colour of the node (t=red, nil=black)
  red
  ;; @field key:* - The key of the node, must be comparable with a
compare
  ;;   function.
  key
  ;; @field value:* - The value of the node. If you insert a value
with a
  ;;   key that already exists it will replace the old value.
  value
  ;; @field left:rbnode - The left child.
  left
  ;; @field right:rbnode - The right child.
  right)

;; A red-black tree.
(defstruct rbtree
  ;; @field root:rbnode - The root of the tree.
  root
  ;; @field size:integer - The number of items.
  size)

;; An iterator over the tree.
(defstruct rbtrav
  ;; @field tree:rbtree - A paired tree.
  tree
  ;; @field it:rbnode - The current node.
  it
  ;; @field path:list(rbnode) - A stack of the traversal path.
  path)

;;
------------------------------------------------------------------------
;; utilities

(defmacro while (test &rest body)
  `(do ()
       ((not ,test))
     ,@body))


(defmacro set-link (node dir &rest value)
  "Set the link of the node based on the direction variable."
  `(if ,dir
       (setf (rbnode-right ,node) ,@value)
     (setf (rbnode-left ,node) ,@value)))

(defmacro get-link (node dir)
  "Get the left or right child link based on the dir."
  `(if ,dir (rbnode-right ,node) (rbnode-left, node)))

;; ----------------------------------------------------------------
;; Checks the color of a red black node.
;;
;; @param root:rbnode - The node to check.
;; @returns boolean - true for a red node, nil for a black node.
(defun is-red (root)
  "Checks the colour of a red black node."
  (and (not (eq root nil)) (rbnode-red root)))

;; ----------------------------------------------------------------
;; The opposite of is-red.
(defmacro is-black (root)
  `(not (is-red ,root)))

;; ----------------------------------------------------------------
;; Perform a single red-black rotation to the left.
;;
;; @param root:rbnode - The original root to rotate to the left.
;; @returns rbnode - The new root ater rotation.
(defun rotate-left (root)
  "Perform a single red-black rotation to the left."
  (let ((save (rbnode-right root)))

    (setf (rbnode-right root) (rbnode-left save))
    (setf (rbnode-left save) root)

    (setf (rbnode-red root) t)
    (setf (rbnode-red save) nil)

    save))

;; ----------------------------------------------------------------
;; Perform a single red-black rotation to the right.
;;
;; @param root:rbnode - The original root to rotate to the right.
;; @returns rbnode - The new root ater rotation.
(defun rotate-right (root)
  "Perform a single red-black rotation to the right."

  (let ((save (rbnode-left root)))

    (setf (rbnode-left root) (rbnode-right save))
    (setf (rbnode-right save) root)

    (setf (rbnode-red root) t)
    (setf (rbnode-red save) nil)

    save))

;; ----------------------------------------------------------------
;;  Performs a single red black rotation in the specified direction.
;;
;;  This function assumes that all nodes are valid for a rotation.
;;
;;  @param root:rbnode - The original root to rotate around.
;;  @param dir:boolean - The direction to rotate (nil = left, t =
right)
;;  @returns rbnode - The new root ater rotation.
(defun rotate (root dir)
  "Perform a single red-black rotation in the specified direction."
  (if dir
      (rotate-right root)
    (rotate-left root)))


;; ----------------------------------------------------------------
;; Perform a double red black rotation to the right.
;; @param root:rbnode - The node to rotate around.
(defun rotate-right-double (root)
  "Perform a double right rotation."
  (setf (rbnode-left root) (rotate-left (rbnode-left root) ))
  (rotate-right root))

;; ----------------------------------------------------------------
;; Perform a double red black rotation to the left.
;; @param root:rbnode - The node to rotate around.
(defun rotate-left-double (root)
  "Perform a double left rotation."
  (setf (rbnode-right root) (rotate-right (rbnode-left root) ))
  (rotate-left root))


;; ----------------------------------------------------------------
;; Perform a double red-black rotation in the specified direction.
;;
;; This function assumes that all nodes are valid for a rotation
;;
;; @param root:rbnode - The original root to rotate around.
;; @param dir:boolean - The direction to rotate (nil = left, t =
right)
;; @returns rbnode - The new root after rotation.
(defun rotate-double (root dir)
  "Perform a double rotation in the specified direction."
  (if dir
      (rotate-right-double root)
    (rotate-left-double root)))

;; ----------------------------------------------------------------
;; Create a new node with the specified key and value. The node
;; has a default colour of red.
;;
;; @param key:* - The key of the of node which must be comparable
;;   using the compare function.
;; @param value:* - The contents of the node.
;; @returns rbnode - The new node
(defun new-node (key value)
  "Create a new node with the specified key and value. The node is
coloured red."
  (make-rbnode :red t :key key :value value :left nil :right nil))

;; ----------------------------------------------------------------
;; Create and initialise an empty red black tree.
;;
;; @return rbnode - A pointer to the new tree.

(defun new-tree ()
  "Create a new empt tree."
  (make-rbtree :root nil :size 0))

;; ----------------------------------------------------------------
;; Release a valid red black node setting all of the contents to
;; nil.
;;
;; @param node:rbnode - The node to release.
(defmethod free ((node rbnode))
  "Free a node in a tree."
  (setf (rbnode-red node) nil)
  (setf (rbnode-key node) nil)
  (setf (rbnode-value node) nil)
  (setf (rbnode-left node) nil)
  (setf (rbnode-right node) nil))

;; ----------------------------------------------------------------
;; Release a valid red black tree.
;;
;; @param node:rbtree - The tree to be torn down.
(defmethod free ((tree rbtree))
  "Release a valid red black tree."
  (let ((it (rbtree-root tree))
        (save (new-node nil nil)))

    ;; Rotate away the left links so that
    ;; we can treat this like the destruction
    ;; of a linked list
    (while it
           (if (rbnode-left it)
               (progn
                 ;; Rotate away the left link and check again
                 (setf save (rbnode-left it))
                 (setf (rbnode-left it) (rbnode-right save))
                 (setf (rbnode-right save) it)))
           (progn
             ;; No left links, just kill the node and move on
             (setf save (rbnode-right it))
             (free it))
           (setf it save))

    (setf (rbtree-root tree) nil)
    (setf (rbtree-size tree) 0)))

;; ----------------------------------------------------------------
;; Search for a copy of the specified node data in a red black tree.
;;
;; @param tree:rbtree - The tree to search.
;; @param key:* - The key of the node to search for.
;; @returns * - The value of the node matching the key or nil if
;;   nothing was found.
(defun find (tree key)
  "Find a value in the tree with a matching key."
  (let ((it (rbtree-root tree)))
    (while it
           (let ((cmp (compare (rbnode-key it) key)))

             (when (equal 0 cmp)
               (return-from find (rbnode-value it)))

             (setf it (get-link it (< cmp 0)))))


    (if it (rbnode-value it) it)))

;; ----------------------------------------------------------------
;; Insert a copy of the user-specified data into a red black tree.
;;
;; @param tree:rbtree - The tree to insert the value into.
;; @param key:* - The key to assign the value to.
;; @param value:* - The value to be inserted into the tree.
;; @returns integer - 1 if the value was inserted successfully,
;;   0 if the insertion failed for any reason.
(defun insert (tree key value)
  "Insert a copy of the value into the tree at location key."

  (if (not (rbtree-root tree))
      (progn
        ;; We have an empty tree; attach the
        ;; new node directly to the root
        (setf (rbtree-root tree) (new-node key value))

        (when (not (rbtree-root tree))
          (return-from insert 0)))
    (progn
      (let ((head (make-rbnode :red nil :key nil :value nil :left
nil :right nil))
            ;; Grandparent.
            (g nil)
            ;; parent
            (tt nil)
            ;; iterator
            (p nil)
            ;; iterator parent.
            (q nil)
            (dir nil)
            (last nil))


        ;;Set up our helpers
        (setf tt head)
        (setf g nil)
        (setf p nil)
        (setf (rbnode-right tt) (rbtree-root tree))
        (setf q (rbtree-root tree))

        ;; Search down the tree for a place to insert.
        (let ((finished nil))
          (while (not finished)

                 (if (not q)
                     (progn
                       ;; Insert a new node at the first null link.
                       (setf q (new-node key value))
                       (set-link p dir q)

                       (when (not q)
                         (return-from insert 0)))
                   (when (and (is-red (rbnode-left q)) (is-red (rbnode-
right q)))
                     ;; Simple red violation: color flip.
                     (setf (rbnode-red q) t)
                     (setf (rbnode-red (rbnode-left q)) nil)
                     (setf (rbnode-red (rbnode-right q)) nil)))

                 (when (and (is-red q) (is-red p))
                   ;; Hard red violation: rotations necessary.
                   (let ((dir2 (eq (rbnode-right tt) g)))
                     (if (eq q (get-link p last))
                         (set-link tt dir2 (rotate g (not last)))
                       (set-link tt dir2 (rotate-double g (not
last))))))

                 ;; Stop working if we inserted a node. This
                 ;; check also disallows duplicates in the tree
                 (let ((cmp (compare (rbnode-key q) key)))
                   (if (equal cmp 0)
                       (progn
                         (setf (rbnode-value q) value)
                         (setf finished t))
                     (progn
                       (setf last dir)
                       (setf dir (< cmp 0))
                       ;; Move the helpers down.
                       (when g
                         (setf tt g))
                       (setf g p)
                       (setf p q)
                       (setf q (get-link q dir)))))))

        ;; Update the root (it may be different)
        (setf (rbtree-root tree) (rbnode-right head)))))

  ;;Make the root black for simplified logic.
  (setf (rbnode-red (rbtree-root tree)) nil)
  (setf (rbtree-size tree) (+ (rbtree-size tree) 1))
  1)

;; ----------------------------------------------------------------
;; Remove a node from a red black tree that matches the
;; user-specified data
;;
;; @param tree:rbtree - The tree to remove from.
;; @param key:* - The key to the node to remove.
;; @returns integer - 1 if the value was removed successfully,
;;   0 if the removal failed for any reason
(defun erase (tree key)
  "Remove a value from the tree that has the matching key."

  (when (rbtree-root tree)
    (let ((head (make-rbnode :red nil :key nil :value nil :left
nil :right nil))
          (q nil)
          (p nil)
          (g nil)
          (f nil)
          (dir t))

      ;; Set up our helpers.
      (setf q head)
      (setf (rbnode-right q) (rbtree-root tree))

      ;; Search and push a red node down to fix red violations as we
go.
      (while (get-link q dir)
             (let ((last dir))

               ;; Move the helpers down.
               (setf g p)
               (setf p q)
               (setf q (get-link q dir))
               (let ((cmp (compare (rbnode-key q) key)))
                 (setf dir (< cmp 0))

                 ;; Save the node with matching data and keep
                 ;; going; we'll do removal tasks at the end
              (when (equal cmp 0)
                (setf f q)

                ;; Push the red node down with rotations and color
flips.
                (when (and (is-black q) (is-black (get-link q dir)))
                  (if (is-red (get-link q (not dir)))
                      (progn
                        (set-link p last (rotate q dir))
                        (setf p (get-link p last)))

                    (when (is-black (get-link q (not dir)))
                      (let ((s (get-link p (not last))))
                        (when s
                          (if (and (is-black (rbnode-left s)) (is-
black (rbnode-right s)))
                              (progn
                                ;; Color flip.
                                (setf (rbnode-red p)
nil)
                                (setf (rbnode-red s)
t)
                                (setf (rbnode-red q) t))
                            (progn
                              (let ((dir2 (eq (rbnode-right g) p)))
                                (if (is-red (get-link s last))
                             (set-link g dir2 (rotate-double p last))
                                  (when (is-red (get-link s (not
last)))
                                    (set-link g dir2 (rotate p
last))))
                                ;; Ensure correct coloring.
                                (setf (rbnode-red (get-link g dir2))
t)
                                (setf (rbnode-red q) t)
                                (setf (rbnode-red (rbnode-left (get-
link g dir2))) nil)
                                (setf (rbnode-red (rbnode-right (get-
link g dir2))) nil)))))))))))))
      ;; Replace and remove the saved node.
      (when f
        (setf (rbnode-key f) (rbnode-key q))
        (setf (rbnode-value f) (rbnode-value q))

        (set-link p (eq (rbnode-right p) q) (get-link q (eq (rbnode-
left q) nil)))
        (free q))

      ;; Update the root (it may be different)
      (setf (rbtree-root tree) (rbnode-right head))

      ;; Make the root black for simplified logic.
      (when (rbtree-root tree)
        (setf (rbnode-red (rbtree-root tree)) nil)

        (setf (rbtree-size tree) (- (rbtree-size tree) 1)))))
     1)

;; ----------------------------------------------------------------
;; Gets the number of nodes in a red black tree.
;;
;; @param tree:rbtree - The tree to calculate a size for.
;; @returns integer - The number of nodes in the tree.
(defun size (tree)
  "Obtain the size of the tree."
  (rbtree-size tree))

;; ----------------------------------------------------------------
;; Create a new traversal object.
;;
;; @param tree:rbtree - The tree to create the iterator for.
;; @returns rbtrav - A new iterator object.

(defun iterator (tree)
  "Create a new iterator over the tree."
  (make-rbtrav :tree tree :it nil :path nil))

;; ----------------------------------------------------------------
;; Release a traversal object.
;;
;; @param i:rbtrav - The iterator to be released.
(defmethod free ((i rbtrav))
  "Release the iterator object."
  (setf (rbtrav-tree i) nil)
  (setf (rbtrav-it i) nil)
  (setf (rbtrav-path) nil))

;; ----------------------------------------------------------------
;; Initialize a traversal object. The user-specified
;; direction determines whether to begin traversal at the
;; smallest or largest valued node
;;
;; @param i:rbtrav - The traversal object to initialize.
;; @param dir:boolean - direction to traverse (nil = ascending, t =
descending)
;; @preturns rbnode - A reference to the smallest or largest data
value.

(defun start (i dir)
  "Initialise the iterator at the beginning of the tree either the
smallest value or the biggest."
  (setf (rbtrav-it i) (rbtree-root (rbtrav-tree i)))
  (setf (rbtrav-path i) nil)

  ;; Save the path for later traversal.
  (when (rbtrav-it i)
    (while (get-link (rbtrav-it i) dir)
           (push (rbtrav-it i) (rbtrav-path i))
           (setf (rbtrav-it i) (get-link (rbtrav-it i) dir))))

  (if (rbtrav-it i)
      (rbnode-value (rbtrav-it i))
    nil))

;; ----------------------------------------------------------------
;; Traverse a red black tree in the user-specified direction
;;
;; @param trav:rbtrav - The initialized traversal object.
;; @param dir:boolean - The direction to traverse (nil = ascending, t
= descending)
;; @returns rbnode - A reference to the next data value in the
specified direction.
(defun move (trav dir)
  "Traverse the red black tree one step in the specified direction."

  (when (not (rbtrav-it trav))
    (return-from move nil))
  (if (get-link (rbtrav-it trav) dir)
      (progn
        ;; Continue down this branch
        (push (rbtrav-it trav) (rbtrav-path trav))
        (setf (rbtrav-it trav) (get-link (rbtrav-it trav) dir))

       (while (get-link (rbtrav-it trav) (not dir))
         (push (rbtrav-it trav) (rbtrav-path trav))
         (setf (rbtrav-it trav) (get-link (rbtrav-it trav) (not
dir)))))
    (progn
      ;; Move to the next branch
      (let ((last nil)
            (finished nil))

        (while (not finished)
               (if (not (rbtrav-path trav))
                   (progn
                     (setf (rbtrav-it trav) nil)
                     (setf finished t))
                 (progn
                   (setf last (rbtrav-it trav))
                   (setf (rbtrav-it trav) (pop (rbtrav-path trav)))))

               (when (not finished)
                 (setf finished (not (eq last (get-link (rbtrav-it
trav) dir)))))))))

  (if (rbtrav-it trav)
      (rbnode-value (rbtrav-it trav))
    nil))

;; ----------------------------------------------------------------
;; Initialize a traversal object to the smallest valued node
;;
;; @param trav:rbtrav - The traversal object to initialize.
;; @returns rbnode - A reference to the smallest data value.
(defun first (trav)
  "Move the iterator to the smallest key value node."
  (start trav nil))

;; ----------------------------------------------------------------
;; Initialize a traversal object to the largest valued node
;;
;; @param trav:rbtrav - The traversal object to initialize.
;; @returns rbnode - A reference to the largest data value.
(defun last (trav)
  "Move the iterator to the largest key value node."
  (start trav t))

;; ----------------------------------------------------------------
;; Traverse to the next value in ascending order.
;;
;; @param trav:rbtrav - The initialized traversal object.
;; @returns rbnode - A reference to the next value in ascending order.
(defun next (trav)
  "Move the iterator to the next value in key ascending order."
  (move trav t))

;; ----------------------------------------------------------------
;; Traverse to the next value in descending order
;;
;; @param trav:rbtrav - The initialized traversal object.
;; @returns rbnode - A reference to the next value in descending
order.
(defun prev (trav)
  "Move the iterator to the next value in descending key order."
  (move trav nil))

(defmethod str (node)
  "A string representation of the node."
  (if node
      (let ((colour (if (rbnode-red node) "RED" "BLACK")))
        (format nil "(key: ~A value: ~A colour: ~A left: ~A right:
~A)" (rbnode-key node) (rbnode-value node) colour (str (rbnode-left
node)) (str (rbnode-right node))))
    "NULL"))

(defmethod dump (tree)
  "Dump the contents of a tree."
  (format t "tree: ~A~%" (str (rbtree-root tree))))

;; A test comparision method.
(defun compare (a b)
  (when (< a b)
    (return-from compare -1))
  (when (> a b)
    (return-from compare +1))
  0)


(defun test-tree-creation ()
  (let ((tree (new-tree)))

    (insert tree 1 "a")
    (insert tree 2 "b")
    (insert tree 12 "c")
    (insert tree 12 "c")
    (insert tree 12 "c")
    (insert tree -1 "d")
    (insert tree -1 "d")
    (insert tree 12 "c")

    (assert (equal (find tree -1) "d") nil "Did not get 'd' for -1")
    (assert (equal (find tree 1) "a") nil "Did not get 'a' for 1")
    (assert (equal (find tree 2) "b") nil "Did not get 'b' for 2")
    (assert (equal (find tree 12) "c") nil "Did not get 'c' for 12")))

(defun test-node-erase ()
  (let ((tree (new-tree)))

    (insert tree 4 "a")
    (insert tree 3 "b")
    (insert tree 2 "c")
    (insert tree 1 "d")

    (assert (equal (find tree 1) "d") nil "Did not get 'd' for 1")
    (assert (equal (find tree 2) "c") nil "Did not get 'c' for 2")
    (assert (equal (find tree 3) "b") nil "Did not get 'b' for 3")
    (assert (equal (find tree 4) "a") nil "Did not get 'a' for 4")

    (erase tree 2)
    (assert (eq (find tree 2) nil) nil "Should not have found 2 after
it was deleted.")
    (assert (equal (find tree 1) "d") nil "Did not get 'd' for 1")
    (assert (equal (find tree 3) "b") nil "Did not get 'b' for 3")
    (assert (equal (find tree 4) "a") nil "Did not get 'a' for 4")

    (erase tree 4)
    (assert (eq (find tree 4) nil) nil "Should not have found 4 after
it was deleted.")
    (assert (equal (find tree 1) "d") nil "Did not get 'd' for 1")
    (assert (equal (find tree 3) "b") nil "Did not get 'b' for 3")

    (erase tree 1)
    (assert (eq (find tree 1) nil) nil "Should not have found 1 after
it was deleted.")
    (assert (equal (find tree 3) "b") nil "Did not get 'b' for 3")

    (erase tree 3)
    (assert (eq (find tree 4) nil) nil "Should not have found 4 after
it was deleted.")
    (assert (eq (find tree 3) nil) nil "Should not have found 3 after
it was deleted.")
    (assert (eq (find tree 2) nil) nil "Should not have found 2 after
it was deleted.")
    (assert (eq (find tree 1) nil) nil "Should not have found 1 after
it was deleted.")

    (erase tree 3)))

(defun test-tree-erase ()
  (let ((tree (new-tree)))

    (insert tree 4 "a")
    (insert tree 3 "b")
    (insert tree 2 "c")
    (insert tree 1 "d")

    (assert (equal (find tree 1) "d") nil "Did not get 'd' for 1")
    (assert (equal (find tree 2) "c") nil "Did not get 'c' for 2")
    (assert (equal (find tree 3) "b") nil "Did not get 'b' for 3")
    (assert (equal (find tree 4) "a") nil "Did not get 'a' for 4")

    (free tree)

    (assert (eq (find tree 4) nil) nil "Should not have found 4 after
it was deleted.")
    (assert (eq (find tree 3) nil) nil "Should not have found 3 after
it was deleted.")
    (assert (eq (find tree 2) nil) nil "Should not have found 2 after
it was deleted.")
    (assert (eq (find tree 1) nil) nil "Should not have found 1 after
it was deleted.")))

(defun test-iterator ()
  (let ((tree (new-tree)))

    (insert tree 4 "a")
    (insert tree 3 "b")
    (insert tree 2 "c")
    (insert tree 1 "d")

    (let ((i (iterator tree)))
      (assert (equal (first i) "d") nil "The first element should have
been 'd'")
      (assert (equal (next i) "c") nil "Was expecting 'c' next.")
      (assert (equal (next i) "b") nil "Was expecting 'b' next yet
again.")
      (assert (equal (prev i) "c") nil "Was expecting 'c' as the
previous item.")
      (assert (equal (next i) "b") nil "Was expecting 'b' next yet
again again.")
      (assert (equal (next i) "a") nil "Was expecting 'a' next.")
      (assert (not (next i)) nil "Was expecting nil this time.")
      (assert (equal (last i) "a") nil "Last was meant to be 'a'.")
      (assert (not (next i)) nil "The next item past the last one
should have been nil.")
      (assert (not (next i)) nil "The next item past the last one
should have been nil again.")
      (assert (equal (first i) "d") nil "The first element should have
been 'd' as it was before.")
      (assert (not (prev i)) nil "The previous item to the first one
should have been nil.")
      (assert (not (prev i)) nil "The previous item to the first one
should have been nil again."))))

(defun run-tests ()

  (test-tree-creation)
  (test-node-erase)
  (test-tree-erase)
  (test-iterator))

;; (run-tests)

From: Volkan YAZICI
Subject: Re: Yet another red-black tree implementation.
Date: 
Message-ID: <2d63daec-fd30-4130-ac2b-b4db98f14d61@d77g2000hsb.googlegroups.com>
On Sep 12, 1:03 pm, ·········@hotmail.com wrote:
> I needed a red-black tree implementation for a side project I am
> doing.

What's wrong with rb-tree implementation of trees[1] or cl-
containers[2] packages?


Regards.

[1] http://www.cliki.net/TREES
[2] http://www.cliki.net/cl-containers
From: ·········@hotmail.com
Subject: Re: Yet another red-black tree implementation.
Date: 
Message-ID: <819b2e8f-c2f4-4282-83ec-90191aed9025@b38g2000prf.googlegroups.com>
On Sep 12, 10:10 pm, Volkan YAZICI <·············@gmail.com> wrote:
> On Sep 12, 1:03 pm, ·········@hotmail.com wrote:
>
> > I needed a red-black tree implementation for a side project I am
> > doing.
>
> What's wrong with rb-tree implementation of trees[1] or cl-
> containers[2] packages?
>

I looked at both of those but I couldn't understand exactly how they
worked and I wanted something more atomic that I could step through.
It doesn't say much for me but at the moment I find it easier to
understand the C and Java versions of the algorithms than the Lisp
ones.

As an exercise I learned a lot more about how red-black trees worked
from both Robert Sedgewick and Julienne Walkers articles on the
subject. Porting the code also makes you think about what the author
was trying to achieve.

But yes either of the two sources you cite are fine implementations
and would have been adequate.

Regards,

Matthew
From: Marco Antoniotti
Subject: Re: Yet another red-black tree implementation.
Date: 
Message-ID: <8c09f72d-1f36-408f-a657-4bd62f342da8@59g2000hsb.googlegroups.com>
On Sep 12, 2:10 pm, Volkan YAZICI <·············@gmail.com> wrote:
> On Sep 12, 1:03 pm, ·········@hotmail.com wrote:
>
> > I needed a red-black tree implementation for a side project I am
> > doing.
>
> What's wrong with rb-tree implementation of trees[1] or cl-
> containers[2] packages?
>
> Regards.
>
> [1]http://www.cliki.net/TREES
> [2]http://www.cliki.net/cl-containers

That they came after mine? :)

http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/code/ext/trees/0.html

Sorry.  Pretty bad NIH attack!  :)

Cheers
--
Marco
From: John Thingstad
Subject: Re: Yet another red-black tree implementation.
Date: 
Message-ID: <op.uhc7vdy0ut4oq5@pandora.alfanett.no>
P� Fri, 12 Sep 2008 12:03:20 +0200, skrev <·········@hotmail.com>:

> Hi,
>
> I needed a red-black tree implementation for a side project I am
> doing. I originally tried to get Robert Sedgewick's left leaning red
> black tree algorithm running in Lisp but ran into troubles with
> delete. I had no such problems with porting Julienne Walker's,
> http://eternallyconfuzzled.com, C version. It also doesn't use parent
> pointers and is quite compact.
>
> It is about 700 lines long which is probably to long to post on this
> news group but I couldn't think of anywhere else it should go.
>
> Regards,
>

You could use http://paste.lisp.org/ to paste the code. This generates a  
unique address you can link to in your email.

--------------
John Thingstad
From: Rainer Joswig
Subject: Re: Yet another red-black tree implementation.
Date: 
Message-ID: <joswig-2DBEEE.17574713092008@news-europe.giganews.com>
In article 
<····································@s9g2000prg.googlegroups.com>,
 ·········@hotmail.com wrote:

> Hi,
> 
> I needed a red-black tree implementation for a side project I am
> doing. I originally tried to get Robert Sedgewick's left leaning red
> black tree algorithm running in Lisp but ran into troubles with
> delete. I had no such problems with porting Julienne Walker's,
> http://eternallyconfuzzled.com, C version. It also doesn't use parent
> pointers and is quite compact.
> 
> It is about 700 lines long which is probably to long to post on this
> news group but I couldn't think of anywhere else it should go.

Remember, your newreader adds line breaks at long lines.
This breaks your code.

Please put it somewhere else or post code without line breaks..

-- 
http://lispm.dyndns.org/