data-red-black: augmented red black tree structures

7.7

top ← prev up next →

data-red-black: augmented red black tree structures

The data/red-black library consists of several red-black tree data structures. Its contents include two red-black tree implementations:

data/red-black/positional: meant to support position-based queries
data/red-black/augmented: meant to support flexible node extensions

as well as an application of augmented red-black trees to support an ordered set collection in data/red-black/ordered-set.

1 Positional Red-Black Trees

Danny Yoo <dyoo@hashcollision.org>

(require data/red-black/positional)
	package: data-red-black

This is an implementation of an augmented red-black tree with extra information to support position-based queries.

The intended usage case of this structure is to maintain an ordered sequence of items, where each item has an internal length. Given such a sequence, we want to support quick lookup by position and in-place insertions and deletions. We also want to support the catenation and splitting of sequences.

For example:

> (define a-tree (new-tree))
> (for ([w (in-list '("This" " " "is" " " "a" " " "test"))])
(insert-last/data! a-tree w (string-length w)))
> (node-data (search a-tree 0))
"This"
> (node-data (search a-tree 10))
"test"
> (define at-test-node (search a-tree 10))
> (insert-before/data! a-tree at-test-node "small" 5)
> (tree-items a-tree)
'(("This" 4) (" " 1) ("is" 2) (" " 1) ("a" 1) (" " 1) ("small" 5) ("test" 4))
; Split at the node holding "small":
> (define at-small-node (search a-tree 10))
> (define-values (left-side right-side) (split! a-tree at-small-node))
> (tree-items left-side)
'(("This" 4) (" " 1) ("is" 2) (" " 1) ("a" 1) (" " 1))
> (tree-items right-side)
'(("test" 4))
> (define joined-tree (join! left-side right-side))
> (tree-items joined-tree)
'(("This" 4) (" " 1) ("is" 2) (" " 1) ("a" 1) (" " 1) ("test" 4))

This implementation follows the basic outline for order-statistic red-black trees described in [clrs2009] and incorporates a few extensions suggsted in [wein2005]. As a red-black tree, the structure ensures that the tree’s height is never greater than 2*lg(#-of-nodes + 1), guaranteeing good worst-case behavior for its operations.

The main types of values used in the library are trees and nodes. A tree has a root node, and each node has holds arbitrary data and a natural self-width, along with a reference to the elements smaller (node-left) and larger (node-right). Each node also remembers the entire width of its subtree, which can be accessed with node-subtree-width. The tree holds first and last pointers into the structure to allow for fast access to the beginning and end of the sequence. A distinguished nil node lies at the leaves of the tree.

1.1 API

1.1.1 Data types

procedure
(new-tree) → tree?

Constructs a new tree. The tree’s root is initially nil.

> (define a-tree (new-tree))
> a-tree
#<tree>
> (nil-node? (tree-root a-tree))
#t

procedure
(tree? x) → boolean?
x : any/c

Returns #t if x is a tree.

> (define a-tree (new-tree))
> (tree? a-tree)
#t
> (tree? "not a tree")
#f
> (tree? (new-node '(not a tree either) 0))
#f

procedure
(tree-root t) → node?
t : tree?

Returns the root node of the tree t. If the tree is empty, returns the distinguished nil node.

> (define a-tree (new-tree))
> (nil-node? (tree-root (new-tree)))
#t
> (define a-node (new-node "first node!" 11))
> (insert-first! a-tree a-node)
> (eq? a-node (tree-root a-tree))
#t

procedure
(tree-first t) → node?
t : tree?

Returns the first node in the tree.

> (define a-tree (new-tree))
> (nil-node? (tree-first (new-tree)))
#t
> (define a-node (new-node "first node!" 11))
> (define another-node (new-node "last node!" 11))
> (insert-first! a-tree a-node)
> (insert-last! a-tree another-node)
> (eq? a-node (tree-first a-tree))
#t

procedure
(tree-last t) → node?
t : tree?

Returns the last node in the tree.

> (define a-tree (new-tree))
> (nil-node? (tree-first (new-tree)))
#t
> (define a-node (new-node "first node!" 11))
> (define another-node (new-node "last node!" 11))
> (insert-first! a-tree a-node)
> (insert-last! a-tree another-node)
> (eq? another-node (tree-last a-tree))
#t

procedure
(new-node data width) → singleton-node?
data : any/c
width : natural-number/c

Constructs a new singleton node. This node can be inserted into a tree with insert-first!, insert-last!, insert-before!, or insert-after!.

> (new-node #("a" "node") 7)
#<node>

procedure
(node? x) → boolean?
x : any/c

Returns #t if x is a node.

> (node? (new-node #("a" "node") 7))
#t
; Trees are not nodes: they _have_ nodes.
> (node? (new-tree))
#f
> (node? (tree-root (new-tree)))
#t

procedure
(singleton-node? x) → boolean?
x : any/c

Returns #t if x is a singleton node. A singleton node is unattached to any tree, and is not the nil node.

> (singleton-node? (new-node #("a" "node") 7))
#t
> (singleton-node? nil)
#f
; Create a fresh node:
> (define a-node (new-node "about to attach" 0))
> (singleton-node? a-node)
#t
; After attachment, it is no longer singleton:
> (define a-tree (new-tree))
> (insert-first! a-tree a-node)
> (singleton-node? a-node)
#f
; Operations such as delete! or split! will break
; off nodes as singletons again:
> (delete! a-tree a-node)
> (singleton-node? a-node)
#t

value
nil : node?

The distinguished nil node. By definition, nil is colored black, and its node-parent, node-left, and node-right are pointed to itself.

procedure
(non-nil-node? x) → boolean?
x : any/c

Returns #t if x is a non-nil node.

> (non-nil-node? nil)
#f
> (non-nil-node? (new-node "I am not a number" 1))
#t

procedure
(nil-node? x) → boolean?
x : any/c

Returns #t if x is the nil node.

> (nil-node? nil)
#t
> (nil-node? (new-node "I am not a number" 1))
#f

procedure
(node-data n) → any/c
n : node?

Returns the data associated to node n. Note that the node-data and node-self-width are entirely independent.

> (define a-node (new-node "utah" 4))
> (node-data a-node)
"utah"

procedure
(set-node-data! n v) → void?
n : node?
v : any/c

Assigns the data associated to node n. Note that the node-data and node-self-width are entirely independent.

> (define a-node (new-node "utah" 4))
> (set-node-data! a-node "rhode island")
> (node-data a-node)
"rhode island"

procedure
(node-self-width n) → any/c
n : node?

Returns the self-width associated to node n. Note that the node-data and node-self-width are entirely independent.

> (define a-node (new-node "utah" 4))
> (node-self-width a-node)
4

procedure
(update-node-self-width! n w) → any/c
n : node?
w : natural-number/c

Updates the self-width associated to node n. When attached to a tree, also propagates the width’s change to the widths of subtrees, upward through its parents to the root. Note that the node-data and node-self-width are entirely independent.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "hello" 5)
> (insert-last/data! a-tree "world" 1)
; The tree as a whole has width 6:
> (node-subtree-width (tree-root a-tree))
6
; Updates will propagate to the root:
> (update-node-self-width! (tree-last a-tree) 5)
> (node-self-width (tree-last a-tree))
5
> (node-subtree-width (tree-root a-tree))
10

procedure
(node-subtree-width n) → any/c
n : node?

Returns the width of the entire subtree at node n. This sums the width of the left and right child subtrees, as well as its self-width.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "berkeley" 1)
> (insert-last/data! a-tree "stanford" 1)
> (insert-last/data! a-tree "wpi" 1)
> (insert-last/data! a-tree "brown" 1)
> (insert-last/data! a-tree "utah" 1)
; The entire tree should sum to five, since each element contributes one.
> (node-subtree-width (tree-root a-tree))
5
> (node-subtree-width (node-left (tree-root a-tree)))
1
> (node-subtree-width (node-right (tree-root a-tree)))
3

procedure
(node-parent n) → node?
n : node?

Returns the parent of the node n.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "bill and ted's excellent adventure" 1)
> (insert-last/data! a-tree "the matrix" 1)
> (insert-last/data! a-tree "speed" 1)
> (define p (node-parent (tree-last a-tree)))
> (node-data p)
"the matrix"

procedure
(node-left n) → node?
n : node?

Returns the left child of the node n.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "bill and ted's excellent adventure" 1)
> (insert-last/data! a-tree "the matrix" 1)
> (insert-last/data! a-tree "speed" 1)
> (define p (node-left (tree-root a-tree)))
> (node-data p)
"bill and ted's excellent adventure"

procedure
(node-right n) → node?
n : node?

Returns the right child of the node n.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "bill and ted's excellent adventure" 1)
> (insert-last/data! a-tree "the matrix" 1)
> (insert-last/data! a-tree "speed" 1)
> (define p (node-right (tree-root a-tree)))
> (node-data p)
"speed"

procedure
(node-color n) → (or/c 'red 'black)
n : node?

Returns the color of the node n. The red-black tree structure uses this value to maintain balance.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "the color purple" 1)
> (insert-last/data! a-tree "pretty in pink" 1)
> (insert-last/data! a-tree "the thin red line" 1)
> (insert-last/data! a-tree "clockwork orange" 1)
> (insert-last/data! a-tree "fried green tomatoes" 1)
> (node-color (tree-root a-tree))
'black
> (tree-fold-inorder a-tree
                     (lambda (n acc)
                       (cons (list (node-data n) (node-color n))
                             acc))
                     '())
'(("fried green tomatoes" red)
  ("clockwork orange" black)
  ("the thin red line" red)
  ("pretty in pink" black)
  ("the color purple" black))

procedure
(red? n) → boolean?
n : node?

Returns #t if node n is red.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "the hobbit" 1)
> (insert-last/data! a-tree "the fellowship of the ring" 1)
> (red? (tree-root a-tree))
#f
> (red? (node-right (tree-root a-tree)))
#t

procedure
(black? n) → boolean?
n : node?

Returns #t if node n is black.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "the fellowship of the ring" 1)
> (insert-last/data! a-tree "the two towers" 1)
> (insert-last/data! a-tree "return of the king" 1)
; The root is always black.
> (black? (tree-root a-tree))
#t
; The tree should have towers as the root, with
; the fellowship and king as left and right respectively.
> (map node-data
       (list (tree-root a-tree)
             (node-left (tree-root a-tree))
             (node-right (tree-root a-tree))))
'("the two towers" "the fellowship of the ring" "return of the king")
> (black? (tree-root a-tree))
#t
> (black? (node-left (tree-root a-tree)))
#f
> (black? (node-right (tree-root a-tree)))
#f

1.1.2 Operations

procedure
(insert-first! t n) → void?
t : tree?
n : singleton-node?

Adds node n as the first element in tree t.

> (define a-tree (new-tree))
> (define a-node (new-node "pear" 1))
> (insert-first! a-tree a-node)
> (eq? (tree-root a-tree) a-node)
#t

Note that attempting to add an attached, non-singleton node to a tree will raise a contract error.

> (define a-tree (new-tree))
> (define a-node (new-node "persimmon" 1))
> (insert-first! a-tree a-node)
> (insert-first! a-tree a-node)
insert-first!: contract violation
  expected: singleton-node?
  given: #<node>
  in: the 2nd argument of
      (-> tree? singleton-node? any)
  contract from:
      <pkgs>/data-red-black/data/red-black/positional.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/positional.rkt:81.11

procedure
(insert-last! t n) → void?
t : tree?
n : singleton-node?

Adds node n as the last element in tree t.

> (define a-tree (new-tree))
> (define a-node (new-node "apple" 1))
> (insert-last! a-tree a-node)
> (eq? (tree-root a-tree) a-node)
#t

Note that attempting to add an attached, non-singleton node to a tree will raise a contract error.

> (define a-tree (new-tree))
> (define a-node (new-node "orange" 1))
> (insert-last! a-tree a-node)
> (insert-last! a-tree a-node)
insert-last!: contract violation
  expected: singleton-node?
  given: #<node>
  in: the 2nd argument of
      (-> tree? singleton-node? any)
  contract from:
      <pkgs>/data-red-black/data/red-black/positional.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/positional.rkt:82.11

procedure
(insert-before! t n1 n2) → void?
  t : tree?
  n1 : node?
  n2 : node?

Adds node n2 before node n1 in tree t. This effectively makes n2 the predecessor of n1.

> (define a-tree (new-tree))
> (define a-node (new-node "banana" 1))
> (define b-node (new-node "mango" 1))
> (insert-first! a-tree a-node)
> (insert-before! a-tree a-node b-node)
> (eq? (predecessor a-node) b-node)
#t
> (eq? (successor b-node) a-node)
#t

Note that attempting to add an attached, non-singleton node to a tree will raise a contract error.

> (define a-tree (new-tree))
> (define a-node (new-node "peach" 1))
> (insert-first! a-tree a-node)
> (insert-before! a-tree a-node a-node)
insert-before!: contract violation
  expected: singleton-node?
  given: #<node>
  in: the 3rd argument of
      (-> tree? non-nil-node? singleton-node? any)
  contract from:
      <pkgs>/data-red-black/data/red-black/positional.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/positional.rkt:83.11

procedure
(insert-after! t n1 n2) → void?
  t : tree?
  n1 : node?
  n2 : node?

Adds node n2 after node n1 in tree t. This effectively makes n2 the successor of n1.

> (define a-tree (new-tree))
> (define a-node (new-node "cherry" 1))
> (define b-node (new-node "pawpaw" 1))
> (insert-first! a-tree a-node)
> (insert-after! a-tree a-node b-node)
> (eq? (successor a-node) b-node)
#t
> (eq? (predecessor b-node) a-node)
#t

Note that attempting to add an attached, non-singleton node to a tree will raise a contract error.

> (define a-tree (new-tree))
> (define a-node (new-node "grapefruit" 1))
> (insert-first! a-tree a-node)
> (insert-after! a-tree a-node a-node)
insert-after!: contract violation
  expected: singleton-node?
  given: #<node>
  in: the 3rd argument of
      (-> tree? non-nil-node? singleton-node? any)
  contract from:
      <pkgs>/data-red-black/data/red-black/positional.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/positional.rkt:84.11

procedure
(insert-first/data! t data width) → void?
  t : tree?
  data : any/c
  width : natural-number/c
procedure
(insert-last/data! t data width) → void?
  t : tree?
  data : any/c
  width : natural-number/c
procedure
(insert-before/data! t n data width) → void?
  t : tree?
  n : node?
  data : any/c
  width : natural-number/c
procedure
(insert-after/data! t n data width) → void?
  t : tree?
  n : node?
  data : any/c
  width : natural-number/c

For user convenience, the functions insert-first/data!, insert-last/data!, insert-before/data!, and insert-after/data! have been provided. These create nodes and insert into the tree structure the same way as insert-first!, insert-last!, insert-before!, and insert-after!.

> (define t (new-tree))
> (insert-first/data! t "message in a bottle" 1)
> (insert-last/data! t "don't stand so close to me" 1)
> (insert-before/data! t (tree-first t) "everything she does is magic" 1)
> (insert-after/data! t (tree-last t) "king of pain" 1)
> (tree-items t)
'(("everything she does is magic" 1)
  ("message in a bottle" 1)
  ("don't stand so close to me" 1)
  ("king of pain" 1))

procedure
(delete! t n) → void?
t : tree?
n : non-nil-node?

Deletes node n from the tree t. After deletion, n will become a singleton node.

> (define t (new-tree))
> (define n1 (new-node "George, George, George of the Jungle," 1))
> (define n2 (new-node "strong as he can be..." 1))
> (define n3 (new-node "aaaaaaaaaaah!" 1))
> (define n4 (new-node "watch out for that..." 1))
> (define n5 (new-node "<thump!>" 1))
> (define n6 (new-node "treeeeeeeeee!, " 1))
> (for ([n (in-list (list n1 n2 n3 n4 n5 n6))])
    (insert-last! t n))
> (delete! t n5)
> (tree-items t)
'(("George, George, George of the Jungle," 1)
  ("strong as he can be..." 1)
  ("aaaaaaaaaaah!" 1)
  ("watch out for that..." 1)
  ("treeeeeeeeee!, " 1))

Note that n must be attached to tree t or else will raise a contract error:

> (define t1 (new-tree))
> (insert-first/data! t1 "tricky" 1)
> (define n (new-node "tricky" 1))
; This should raise an error:
> (delete! t1 n)
delete!: contract violation
  expected: attached-in-tree/c
  given: #<node>
  in: the n argument of
      (->i
       ((t tree?) (n (t) (attached-in-tree/c t)))
       (result any/c))
  contract from:
      <pkgs>/data-red-black/data/red-black/positional.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/positional.rkt:90.11

procedure
(join! t1 t2) → tree?
t1 : tree?
t2 : tree?

Destructively joins trees t1 and t2, returning a tree that has the contents of both. Every element in t1 is treated less than the elements in t2.

> (define t1 (new-tree))
> (for ([name (in-list '(goku gohan krillin piccolo vegeta))])
    (insert-last/data! t1 name 1))
; Tier two characters:
> (define t2 (new-tree))
> (for ([name (in-list '(yamcha tien chiaotzu bulma chi-chi
                         roshi))])
    (insert-last/data! t2 name 1))
> (define tree-of-mighty-z-warriors (join! t1 t2))
> (map car (tree-items tree-of-mighty-z-warriors))
'(goku gohan krillin piccolo vegeta yamcha tien chiaotzu bulma chi-chi roshi)

Note that t1 should not be eq? to t2 or else will raise a contract error.

> (define t1 (new-tree))
> (join! t1 t1)
join!: contract violation
  expected: (and/c tree? not-eq?/c)
  given: #<tree>
  in: the t2 argument of
      (->i
       ((t1 tree?)
        (t2 (t1) (and/c tree? (not-eq?/c t1))))
       (result tree?))
  contract from:
      <pkgs>/data-red-black/data/red-black/positional.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/positional.rkt:93.11

procedure
(concat! t1 n t2) → tree?
  t1 : tree?
  n : singleton-node?
  t2 : tree?

Destructively joins tree t1, singleton node n, and tree t2, returning a tree that has the contents of both. Every element in t1 is treated less than x, and x is treated smaller than all the elements in t2.

> (define t1 (new-tree))
> (define t2 (new-tree))
> (insert-last/data! t1 "inigo" 50)
> (define x (new-node "vizzini" 1))
> (insert-last/data! t2 "fezzik" 100)
> (define poor-lost-circus-performers (concat! t1 x t2))
> (tree-items poor-lost-circus-performers)
'(("inigo" 50) ("vizzini" 1) ("fezzik" 100))

Note that t1 should not be eq? to t2 or else will raise a contract error.

> (define t1 (new-tree))
> (define n (new-node "a-node" 1))
> (concat! t1 n t1)
concat!: contract violation
  expected: (and/c tree? not-eq?/c)
  given: #<tree>
  in: the t2 argument of
      (->i
       ((t1 tree?)
        (n singleton-node?)
        (t2 (t1) (and/c tree? (not-eq?/c t1))))
       (result any/c))
  contract from:
      <pkgs>/data-red-black/data/red-black/positional.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/positional.rkt:95.18

procedure
(split! t n) →
tree? tree?
t : tree?
n : non-nil-node?

Destructively splits tree t into two trees, the first containing the elements smaller than node n, and the second containing those larger. Afterwards, n becomes a singleton node.

> (define t (new-tree))
> (for ([name '(melchior caspar bob balthazar)])
(insert-last/data! t name 1))
> (define bob-node (search t 2))
> (singleton-node? bob-node)
#f
> (define-values (l r) (split! t bob-node))
; We tree kings of orient are:
> (append (tree-items l) (tree-items r))
'((melchior 1) (caspar 1) (balthazar 1))
> (singleton-node? bob-node)
#t

Note that n must be attached to tree t or else raise a contract error.

> (define t (new-tree))
> (for ([name '(melchior caspar bob balthazar)])
    (insert-last/data! t name 1))
; This should raise an error:
> (define t2 (new-tree))
> (insert-last! t2 (new-node "bob" 1))
> (split! t (tree-root t2))
split!: contract violation
  expected: attached-in-tree/c
  given: #<node>
  in: the n argument of
      (->i
       ((t tree?) (n (t) (attached-in-tree/c t)))
       (values (t1 tree?) (t2 tree?)))
  contract from:
      <pkgs>/data-red-black/data/red-black/positional.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/positional.rkt:98.11

procedure
(reset! t) → void?
t : tree?

Resets the contents of the tree to the empty state.

> (define t (new-tree))
> (insert-last/data! t "house" 5)
> (insert-last/data! t "cleaning" 8)
> (tree-items t)
'(("house" 5) ("cleaning" 8))
> (reset! t)
> (tree-items t)
'()

procedure
(search t p) → node?
t : tree?
p : natural-number/c

Searches for the node at or within the given position p of the tree. If the position is out of bounds, returns nil.

> (define t (new-tree))
> (for ([word '("alpha" "beta" "gamma" "delta" "epsilon" "zeta")])
(insert-last/data! t word (string-length word)))
> (node-data (search t 0))
"alpha"
> (node-data (search t 5))
"beta"
> (node-data (search t 6))
"beta"
> (node-data (search t 7))
"beta"
> (node-data (search t 8))
"beta"
> (node-data (search t 9))
"gamma"
> (nil-node? (search t 100))
#t

Note: nodes with a self-width of zero are effectively invisible to search, and will be skipped over.

procedure
(search/residual t p) →
node? natural-number/c
t : tree?
p : natural-number/c

Searches for the node at or within the given position p of the tree. This is an extension of search that returns a second value: the offset into the element where the search has terminated. If the position is out of bounds of any element, the first component of the returned value is nil.

> (define t (new-tree))
> (for ([word '("alpha" "beta" "gamma" "delta" "epsilon" "zeta")])
(insert-last/data! t word (string-length word)))
> (search/residual t 5)
#<node>
0
> (search/residual t 6)
#<node>
1
> (search/residual t 7)
#<node>
2
> (define-values (a-node residual)
(search/residual t 100))
> (nil-node? a-node)
#t
> residual
70
> (+ residual (node-subtree-width (tree-root t)))
100

procedure
(minimum n) → node?
n : node?

Given a node n, returns the minimum element of the subtree rooted at n.

> (define t (new-tree))
> (for ([x (in-list '("ftl" "xcom" "civ"))])
(insert-first/data! t x (string-length x)))
> (node-data (minimum (tree-root t)))
"civ"

Note: to get the minimum of the whole tree, it’s faster to use tree-first.

procedure
(maximum n) → node?
n : node?

Given a node n, returns the maximum element of the subtree rooted at n.

> (define t (new-tree))
> (for ([x (in-list '("ftl" "xcom" "civ"))])
(insert-first/data! t x (string-length x)))
> (node-data (maximum (tree-root t)))
"ftl"

Note: to get the maximum of the whole tree, it’s faster to use tree-last.

procedure
(successor n) → node?
n : node?

Given a node n contained in some tree, returns the immediate successor of n in an inorder traversal of that tree.

> (define partial-alien-tree (new-tree))
> (for ([name '("sectoid" "floater" "thin man" "chryssalid"
"muton" "cyberdisk")])
(insert-last/data! partial-alien-tree name 1))
> (define first-alien (tree-first partial-alien-tree))
> (node-data (successor first-alien))
"floater"
> (node-data (successor (successor first-alien)))
"thin man"

procedure
(predecessor n) → node?
n : node?

Given a node n contained in some tree, returns the immediate predecessor of n in an inorder traversal of that tree.

> (define partial-alien-tree (new-tree))
> (for ([name '("sectoid" "floater" "thin man" "chryssalid"
"muton" "cyberdisk")])
(insert-last/data! partial-alien-tree name 1))
> (define last-alien (tree-last partial-alien-tree))
> (node-data (predecessor last-alien))
"muton"
> (node-data (predecessor (predecessor last-alien)))
"chryssalid"

procedure
(position n) → natural-number/c
n : node?

Given a node n contained in some tree, returns the immediate position of n in that tree.

> (define story-tree (new-tree))
> (for ([word (string-split "if you give a mouse a cookie")])
(insert-last/data! story-tree word (string-length word)))
> (define a-pos (position (tree-last story-tree)))
> a-pos
16
> (node-data (search story-tree a-pos))
"cookie"

procedure
(tree-items t) → (listof/c (list/c any/c natural-number/c))
t : tree?

Given a tree, returns a list of its data and width pairs.

> (define t (new-tree))
> (insert-last/data! t "rock" 4)
> (insert-last/data! t "paper" 5)
> (insert-last/data! t "scissors" 8)
> (tree-items t)
'(("rock" 4) ("paper" 5) ("scissors" 8))

procedure
(tree-fold-inorder t f acc) → any
  t : tree?
  f : (node? any/c . -> . any)
  acc : any/c
procedure
(tree-fold-preorder t f acc) → any
  t : tree?
  f : (node? any/c . -> . any)
  acc : any/c
procedure
(tree-fold-postorder t f acc) → any
  t : tree?
  f : (node? any/c . -> . any)
  acc : any/c

Iterates a function f across the nodes of the tree, in inorder, preorder, and postorder respectively.

> (define t (new-tree))
> (insert-last/data! t "three" 1)
> (insert-last/data! t "blind" 1)
> (insert-last/data! t "mice" 1)
; "blind" should be the root, with
; "three" and "mice" as left and right.
> (define (f n acc) (cons (node-data n) acc))
> (reverse (tree-fold-inorder t f '()))
'("three" "blind" "mice")
> (reverse (tree-fold-preorder t f '()))
'("blind" "three" "mice")
> (reverse (tree-fold-postorder t f '()))
'("three" "mice" "blind")

1.2 Uncontracted library

This library uses contracts extensively to prevent the user from messing up; however, the contract checking may be prohibitively expensive for certain applications.

The uncontracted bindings of this library can be accessed through:

(require (submod data/red-black/positional uncontracted))

This provides the same bindings as the regular API, but with no contract checks. Use this with extreme care: Improper use of the uncontracted form of this library may lead to breaking the red-black invariants, or (even worse) introducing cycles in the structure. If you don’t know whether you should be using the uncontracted forms or not, you probably should not.

2 Augmented Red-Black Trees

Danny Yoo <dyoo@hashcollision.org>

(require data/red-black/augmented)
	package: data-red-black

This is an implementation of an augmented red-black tree that extends the nodes of a basic red-black tree with attached metadata at every node. The metadata at a node should be a function of the data of the current node and the left and right children.

One intended usage case of this structure is to maintain an ordered sequence of items, where each item has an internal length. Given such a sequence, we want to support quick lookup by position and in-place insertions and deletions. We also want to support the catenation and splitting of sequences.

For example:

; Here, the metadata represents the length of the contents
; of the entire subtree:
> (define (size-of-data data)
    (string-length data))
> (define (new-catenated-string-tree)
    (new-tree #:metadata-f (lambda (data left right)
                             (+ (size-of-data data)
                                (or (node-metadata left) 0)
                                (or (node-metadata right) 0)))))
> (define a-tree (new-catenated-string-tree))
> (for ([w (in-list '("This" " " "is" " " "a" " " "test"))])
    (insert-last/data! a-tree w))
; Assuming the metadata is correct at every node, we can search
; for a node by its "position" by using the metadata:
> (define (search a-tree offset)
    (let loop ([offset offset] [a-node (tree-root a-tree)])
      (cond
       [(nil-node? a-node) nil]
       [else
        (define left (node-left a-node))
        (define left-subtree-width (or (node-metadata left) 0))
        (cond [(< offset left-subtree-width)
               (loop offset left)]
              [else
               (define residual-offset (- offset left-subtree-width))
               (define len (size-of-data (node-data a-node)))
               (cond
                [(< residual-offset len)
                 a-node]
                [else
                 (loop (- residual-offset len)
                       (node-right a-node))])])])))
; Now we can search:
> (node-data (search a-tree 0))
"This"
> (node-data (search a-tree 10))
"test"
> (define at-test-node (search a-tree 10))
; We can also insert within the tree,
> (insert-before/data! a-tree at-test-node "small")
> (tree-items a-tree)
'("This" " " "is" " " "a" " " "small" "test")
; and split at the node holding "small".
> (define at-small-node (search a-tree 10))
> (define-values (left-side right-side) (split! a-tree at-small-node))
> (tree-items left-side)
'("This" " " "is" " " "a" " ")
> (tree-items right-side)
'("test")
> (define joined-tree (join! left-side right-side))
> (tree-items joined-tree)
'("This" " " "is" " " "a" " " "test")

The interpretation of the metadata is up to clients. Another approprate metadata may hold subtree size rather than string length, in which case the tree acts as an container where items can be found through their index:

; The definitions above depend on the value of
; size-of-data. Let's mutate it to be evil.
; (Note: don't do this in production code.)
> (set! size-of-data (lambda (data) 1))
; And now we get a different kind of search altogether:
> (define t (new-catenated-string-tree))
> (insert-last/data! t "rock")
> (insert-last/data! t "scissors")
> (insert-after/data! t (tree-first t) "paper")
> (node-data (search t 0))
"rock"
> (node-data (search t 1))
"paper"
> (node-data (search t 2))
"scissors"

This augmented red-black tree implementation follows the basic outline in [clrs2009] and incorporates a few extensions suggsted in [wein2005]. As a red-black tree, the structure ensures that the tree’s height is never greater than 2*lg(#-of-nodes + 1), guaranteeing good worst-case behavior for its operations.

The main types of values used in the library are trees and nodes. A tree has a root node (tree-root), and each node has holds arbitrary data (node-data) and metadata (node-metadata), along with a reference to the elements smaller (node-left) and larger (node-right). The tree holds first and last pointers into the structure to allow for fast access to the beginning and end of the sequence. A distinguished nil node lies at the leaves of the tree.

2.1 API

2.1.1 Data types

procedure
(new-tree [#:metadata-f metadata-f]) → tree?
metadata-f : #f = (or/c #f (any/c node? node? . -> . any))

Constructs a new tree. The tree’s root is initially nil.

> (define a-tree (new-tree))
> a-tree
#<tree>
> (nil-node? (tree-root a-tree))
#t

When provided a #:metadata-f, each node in the tree will have an associated node-metadata that is computed through its node-data, node-left and node-right.

The #:metadata-f must not mutate the tree as a side effect; contracts currently do not enforce this requirement, but may in the future.

procedure
(tree? x) → boolean?
x : any/c

Returns #t if x is a tree.

> (define a-tree (new-tree))
> (tree? a-tree)
#t
> (tree? "not a tree")
#f
> (tree? (new-node '(not a tree either)))
#f

procedure
(tree-root t) → node?
t : tree?

Returns the root node of the tree t. If the tree is empty, returns the distinguished nil node.

> (nil-node? (tree-root (new-tree)))
#t
> (define a-tree (new-tree))
> (define a-node (new-node "first node!"))
> (insert-first! a-tree a-node)
> (eq? a-node (tree-root a-tree))
#t

procedure
(tree-metadata-f t) → (or/c #f (any/c node? node? . -> . any))
t : tree?

Returns the metadata-computing function for the tree t.

> (define a-tree (new-tree))
> (tree-metadata-f a-tree)
#f
> (define (indexed-metadata-f data left right)
(+ 1 (or (node-metadata left) 0) (or (node-metadata right) 0)))
> (define another-tree (new-tree #:metadata-f indexed-metadata-f))
> (tree-metadata-f another-tree)
#<procedure:indexed-metadata-f>

procedure
(tree-first t) → node?
t : tree?

Returns the first node in the tree.

> (define a-tree (new-tree))
> (nil-node? (tree-first (new-tree)))
#t
> (define a-node (new-node "first node!"))
> (define another-node (new-node "last node!"))
> (insert-first! a-tree a-node)
> (insert-last! a-tree another-node)
> (eq? a-node (tree-first a-tree))
#t

procedure
(tree-last t) → node?
t : tree?

Returns the last node in the tree.

> (define a-tree (new-tree))
> (nil-node? (tree-first (new-tree)))
#t
> (define a-node (new-node "first node!"))
> (define another-node (new-node "last node!"))
> (insert-first! a-tree a-node)
> (insert-last! a-tree another-node)
> (eq? another-node (tree-last a-tree))
#t

procedure
(new-node data) → singleton-node?
data : any/c

Constructs a new singleton node. This node can be inserted into a tree with insert-first!, insert-last!, insert-before!, or insert-after!, and spliced with concat!.

> (new-node #("a" "node"))
#<node>

procedure
(node? x) → boolean?
x : any/c

Returns #t if x is a node.

> (node? (new-node #("a" "node")))
#t
; Trees are not nodes: they _have_ nodes.
> (node? (new-tree))
#f
> (node? (tree-root (new-tree)))
#t

procedure
(singleton-node? x) → boolean?
x : any/c

Returns #t if x is a singleton node. A singleton node is unattached to any tree, and is not the nil node.

> (singleton-node? (new-node #("a" "node")))
#t
> (singleton-node? nil)
#f
; Create a fresh node:
> (define a-node (new-node "about to attach"))
> (singleton-node? a-node)
#t
; After attachment, it is no longer singleton:
> (define a-tree (new-tree))
> (insert-first! a-tree a-node)
> (singleton-node? a-node)
#f
; Operations such as delete! or split! will break
; off nodes as singletons again:
> (delete! a-tree a-node)
> (singleton-node? a-node)
#t

value
nil : node?

The distinguished nil node. By definition, nil is colored 'black, its node-metadata is #f, and its node-parent, node-left, and node-right are pointed to itself.

procedure
(non-nil-node? x) → boolean?
x : any/c

Returns #t if x is a non-nil node.

> (non-nil-node? nil)
#f
> (non-nil-node? (new-node "I am not a number"))
#t

procedure
(nil-node? x) → boolean?
x : any/c

Returns #t if x is the nil node.

> (nil-node? nil)
#t
> (nil-node? (new-node "I am not a number"))
#f

procedure
(node-data n) → any/c
n : node?

Returns the data associated to node n.

> (define a-node (new-node "utah"))
> (node-data a-node)
"utah"

procedure
(update-node-data! t n v) → void?
  t : tree?
  n : node?
  v : any/c

Assigns the data associated to node n. Note that this also may update the metadata of the tree if the tree has been constructed with a #:metadata-f.

> (define a-tree (new-tree))
> (define a-node (new-node "utah"))
> (insert-first! a-tree a-node)
> (update-node-data! a-tree a-node "rhode island")
> (node-data a-node)
"rhode island"

procedure
(node-metadata n) → any/c
n : node?

Returns the width of the entire subtree at node n. This sums the width of the left and right child subtrees, as well as its self-width.

> (define (size-metadata str left right)
     (+ 1
        (or (node-metadata left) 0)
        (or (node-metadata right) 0)))
> (define a-tree (new-tree #:metadata-f size-metadata))
> (insert-last/data! a-tree "berkeley")
> (insert-last/data! a-tree "stanford")
> (insert-last/data! a-tree "wpi")
> (insert-last/data! a-tree "brown")
> (insert-last/data! a-tree "utah")
; The entire tree should have a metadata of five, the size of the tree.
> (node-metadata (tree-root a-tree))
5
> (node-metadata (node-left (tree-root a-tree)))
1
> (node-metadata (node-right (tree-root a-tree)))
3

procedure
(node-parent n) → node?
n : node?

Returns the parent of the node n.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "bill and ted's excellent adventure")
> (insert-last/data! a-tree "the matrix")
> (insert-last/data! a-tree "speed")
> (define p (node-parent (tree-last a-tree)))
> (node-data p)
"the matrix"

procedure
(node-left n) → node?
n : node?

Returns the left child of the node n.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "bill and ted's excellent adventure")
> (insert-last/data! a-tree "the matrix")
> (insert-last/data! a-tree "speed")
> (define p (node-left (tree-root a-tree)))
> (node-data p)
"bill and ted's excellent adventure"

procedure
(node-right n) → node?
n : node?

Returns the right child of the node n.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "bill and ted's excellent adventure")
> (insert-last/data! a-tree "the matrix")
> (insert-last/data! a-tree "speed")
> (define p (node-right (tree-root a-tree)))
> (node-data p)
"speed"

procedure
(node-color n) → (or/c 'red 'black)
n : node?

Returns the color of the node n. The red-black tree structure uses this value internally to maintain binary tree balance; most users will not need to inspect this value.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "the color purple")
> (insert-last/data! a-tree "pretty in pink")
> (insert-last/data! a-tree "the thin red line")
> (insert-last/data! a-tree "clockwork orange")
> (insert-last/data! a-tree "fried green tomatoes")
> (node-color (tree-root a-tree))
'black
> (tree-fold-inorder a-tree
                     (lambda (n acc)
                       (cons (list (node-data n) (node-color n))
                             acc))
                     '())
'(("fried green tomatoes" red)
  ("clockwork orange" black)
  ("the thin red line" red)
  ("pretty in pink" black)
  ("the color purple" black))

procedure
(red? n) → boolean?
n : node?

Returns #t if node n is red.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "the hobbit")
> (insert-last/data! a-tree "the fellowship of the ring")
> (red? (tree-root a-tree))
#f
> (red? (node-right (tree-root a-tree)))
#t

procedure
(black? n) → boolean?
n : node?

Returns #t if node n is black.

> (define a-tree (new-tree))
> (insert-last/data! a-tree "the fellowship of the ring")
> (insert-last/data! a-tree "the two towers")
> (insert-last/data! a-tree "return of the king")
; The root is always black.
> (black? (tree-root a-tree))
#t
; The tree should have towers as the root, with
; the fellowship and king as left and right respectively.
> (map node-data
       (list (tree-root a-tree)
             (node-left (tree-root a-tree))
             (node-right (tree-root a-tree))))
'("the two towers" "the fellowship of the ring" "return of the king")
> (black? (tree-root a-tree))
#t
> (black? (node-left (tree-root a-tree)))
#f
> (black? (node-right (tree-root a-tree)))
#f

2.1.2 Operations

procedure
(insert-first! t n) → void?
t : tree?
n : singleton-node?

Adds node n as the first element in tree t.

> (define a-tree (new-tree))
> (define a-node (new-node "pear"))
> (insert-first! a-tree a-node)
> (eq? (tree-root a-tree) a-node)
#t

Note that attempting to add an attached, non-singleton node to a tree will raise a contract error.

> (define a-tree (new-tree))
> (define a-node (new-node "persimmon"))
> (insert-first! a-tree a-node)
> (insert-first! a-tree a-node)
insert-first!: contract violation
  expected: singleton-node?
  given: #<node>
  in: the 2nd argument of
      (-> tree? singleton-node? any)
  contract from:
      <pkgs>/data-red-black/data/red-black/augmented.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/augmented.rkt:71.11

procedure
(insert-last! t n) → void?
t : tree?
n : singleton-node?

Adds node n as the last element in tree t.

> (define a-tree (new-tree))
> (define a-node (new-node "apple"))
> (insert-last! a-tree a-node)
> (eq? (tree-root a-tree) a-node)
#t

Note that attempting to add an attached, non-singleton node to a tree will raise a contract error.

> (define a-tree (new-tree))
> (define a-node (new-node "orange"))
> (insert-last! a-tree a-node)
> (insert-last! a-tree a-node)
insert-last!: contract violation
  expected: singleton-node?
  given: #<node>
  in: the 2nd argument of
      (-> tree? singleton-node? any)
  contract from:
      <pkgs>/data-red-black/data/red-black/augmented.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/augmented.rkt:72.11

procedure
(insert-before! t n1 n2) → void?
  t : tree?
  n1 : node?
  n2 : node?

Adds node n2 before node n1 in tree t. This effectively makes n2 the predecessor of n1.

> (define a-tree (new-tree))
> (define a-node (new-node "banana"))
> (define b-node (new-node "mango"))
> (insert-first! a-tree a-node)
> (insert-before! a-tree a-node b-node)
> (eq? (predecessor a-node) b-node)
#t
> (eq? (successor b-node) a-node)
#t

Note that attempting to add an attached, non-singleton node to a tree will raise a contract error.

> (define a-tree (new-tree))
> (define a-node (new-node "peach"))
> (insert-first! a-tree a-node)
> (insert-before! a-tree a-node a-node)
insert-before!: contract violation
  expected: singleton-node?
  given: #<node>
  in: the 3rd argument of
      (-> tree? non-nil-node? singleton-node? any)
  contract from:
      <pkgs>/data-red-black/data/red-black/augmented.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/augmented.rkt:73.11

procedure
(insert-after! t n1 n2) → void?
  t : tree?
  n1 : node?
  n2 : node?

Adds node n2 after node n1 in tree t. This effectively makes n2 the successor of n1.

> (define a-tree (new-tree))
> (define a-node (new-node "cherry"))
> (define b-node (new-node "pawpaw"))
> (insert-first! a-tree a-node)
> (insert-after! a-tree a-node b-node)
> (eq? (successor a-node) b-node)
#t
> (eq? (predecessor b-node) a-node)
#t

Note that attempting to add an attached, non-singleton node to a tree will raise a contract error.

> (define a-tree (new-tree))
> (define a-node (new-node "grapefruit"))
> (insert-first! a-tree a-node)
> (insert-after! a-tree a-node a-node)
insert-after!: contract violation
  expected: singleton-node?
  given: #<node>
  in: the 3rd argument of
      (-> tree? non-nil-node? singleton-node? any)
  contract from:
      <pkgs>/data-red-black/data/red-black/augmented.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/augmented.rkt:74.11

procedure
(insert-first/data! t data) → void?
  t : tree?
  data : any/c
procedure
(insert-last/data! t data) → void?
  t : tree?
  data : any/c
procedure
(insert-before/data! t n data) → void?
  t : tree?
  n : node?
  data : any/c
procedure
(insert-after/data! t n data) → void?
  t : tree?
  n : node?
  data : any/c

> (define t (new-tree))
> (insert-first/data! t "message in a bottle")
> (insert-last/data! t "don't stand so close to me")
> (insert-before/data! t (tree-first t) "everything she does is magic")
> (insert-after/data! t (tree-last t) "king of pain")
> (tree-items t)
'("everything she does is magic"
  "message in a bottle"
  "don't stand so close to me"
  "king of pain")

procedure
(delete! t n) → void?
t : tree?
n : non-nil-node?

Deletes node n from the tree t. After deletion, n will become a singleton node.

> (define t (new-tree))
> (define n1 (new-node "George, George, George of the Jungle,"))
> (define n2 (new-node "strong as he can be..."))
> (define n3 (new-node "aaaaaaaaaaah!"))
> (define n4 (new-node "watch out for that..."))
> (define n5 (new-node "<thump!>"))
> (define n6 (new-node "treeeeeeeeee!, "))
> (for ([n (in-list (list n1 n2 n3 n4 n5 n6))])
    (insert-last! t n))
> (delete! t n5)
> (tree-items t)
'("George, George, George of the Jungle,"
  "strong as he can be..."
  "aaaaaaaaaaah!"
  "watch out for that..."
  "treeeeeeeeee!, ")

Note that n must be attached to tree t or else will raise a contract error:

> (define t1 (new-tree))
> (insert-first/data! t1 "tricky")
> (define n (new-node "tricky"))
; This should raise an error:
> (delete! t1 n)
delete!: contract violation
  expected: attached-in-tree/c
  given: #<node>
  in: the n argument of
      (->i
       ((t tree?) (n (t) (attached-in-tree/c t)))
       (result any/c))
  contract from:
      <pkgs>/data-red-black/data/red-black/augmented.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/augmented.rkt:80.11

procedure
(join! t1 t2) → tree?
t1 : tree?
t2 : tree?

Destructively joins trees t1 and t2, returning a tree that has the contents of both. Every element in t1 is treated less than the elements in t2.

> (define t1 (new-tree))
> (for ([name (in-list '(goku gohan krillin piccolo vegeta))])
    (insert-last/data! t1 name))
; Tier two characters:
> (define t2 (new-tree))
> (for ([name (in-list '(yamcha tien chiaotzu bulma chi-chi
                         roshi))])
    (insert-last/data! t2 name))
> (define tree-of-mighty-z-warriors (join! t1 t2))
> (tree-items tree-of-mighty-z-warriors)
'(goku gohan krillin piccolo vegeta yamcha tien chiaotzu bulma chi-chi roshi)

Note that t1 and t2 should share the same tree-metadata-f and neither tree should be eq? to the other. Violations of either condition will raise a contract error.

> (define t1 (new-tree))
> (join! t1 t1)
join!: contract violation
  expected: (and/c tree? not-eq?/c share-metadata-f/c)
  given: #<tree>
  in: the t2 argument of
      (->i
       ((t1 tree?)
        (t2
         (t1)
         (and/c
          tree?
          (not-eq?/c t1)
          (share-metadata-f/c t1))))
       (result tree?))
  contract from:
      <pkgs>/data-red-black/data/red-black/augmented.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/augmented.rkt:83.11

procedure
(concat! t1 n t2) → tree?
  t1 : tree?
  n : singleton-node?
  t2 : tree?

> (define t1 (new-tree))
> (define t2 (new-tree))
> (insert-last/data! t1 "inigo")
> (define x (new-node "vizzini"))
> (insert-last/data! t2 "fezzik")
> (define poor-lost-circus-performers (concat! t1 x t2))
> (tree-items poor-lost-circus-performers)
'("inigo" "vizzini" "fezzik")

Note that t1 and t2 should share the same tree-metadata-f and neither tree should be eq? to the other. Violations of either condition will raise a contract error.

> (define (f1 data left right) 1)
> (define (f2 data left right) 1)
; f1 and f2 are distinct function values: they won't compare the same.
> (define t1 (new-tree #:metadata-f f1))
> (define t2 (new-tree #:metadata-f f2))
> (define n (new-node "a-node"))
> (concat! t1 n t2)
concat!: contract violation
  expected: (and/c tree? not-eq?/c share-metadata-f/c)
  given: #<tree>
  in: the t2 argument of
      (->i
       ((t1 tree?)
        (n singleton-node?)
        (t2
         (t1)
         (and/c
          tree?
          (not-eq?/c t1)
          (share-metadata-f/c t1))))
       (result any/c))
  contract from:
      <pkgs>/data-red-black/data/red-black/augmented.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/augmented.rkt:89.18

procedure
(split! t n) →
tree? tree?
t : tree?
n : non-nil-node?

Destructively splits tree t into two trees, the first containing the elements smaller than node n, and the second containing those larger. Afterwards, n becomes a singleton node.

> (define t (new-tree))
> (for ([name '(melchior caspar bob balthazar)])
(insert-last/data! t name))
> (define bob-node (predecessor (tree-last t)))
> (singleton-node? bob-node)
#f
> (define-values (l r) (split! t bob-node))
; We tree kings of orient are:
> (append (tree-items l) (tree-items r))
'(melchior caspar balthazar)
> (singleton-node? bob-node)
#t

Note that n must be attached to tree t or else raise a contract error.

> (define t (new-tree))
> (for ([name '(melchior caspar bob balthazar)])
    (insert-last/data! t name))
; This should raise an error:
> (define t2 (new-tree))
> (insert-last! t2 (new-node "bob"))
> (split! t (tree-root t2))
split!: contract violation
  expected: attached-in-tree/c
  given: #<node>
  in: the n argument of
      (->i
       ((t tree?) (n (t) (attached-in-tree/c t)))
       (values (t1 tree?) (t2 tree?)))
  contract from:
      <pkgs>/data-red-black/data/red-black/augmented.rkt
  blaming: top-level
   (assuming the contract is correct)
  at:
<pkgs>/data-red-black/data/red-black/augmented.rkt:97.11

procedure
(reset! t) → void?
t : tree?

Resets the contents of the tree to the empty state.

> (define t (new-tree))
> (insert-last/data! t "house")
> (insert-last/data! t "cleaning")
> (tree-items t)
'("house" "cleaning")
> (reset! t)
> (tree-items t)
'()

procedure
(minimum n) → node?
n : node?

Given a node n, returns the minimum element of the subtree rooted at n.

> (define t (new-tree))
> (for ([x (in-list '("ftl" "xcom" "civ"))])
(insert-first/data! t x))
> (node-data (minimum (tree-root t)))
"civ"

Note: to get the minimum of a whole tree, it’s faster to use tree-first.

procedure
(maximum n) → node?
n : node?

Given a node n, returns the maximum element of the subtree rooted at n.

> (define t (new-tree))
> (for ([x (in-list '("ftl" "xcom" "civ"))])
(insert-first/data! t x))
> (node-data (maximum (tree-root t)))
"ftl"

Note: to get the maximum of a whole tree, it’s faster to use tree-last.

procedure
(successor n) → node?
n : node?

Given a node n contained in some tree, returns the immediate successor of n in an inorder traversal of that tree.

> (define partial-alien-tree (new-tree))
> (for ([name '("sectoid" "floater" "thin man" "chryssalid"
"muton" "cyberdisk")])
(insert-last/data! partial-alien-tree name))
> (define first-alien (tree-first partial-alien-tree))
> (node-data (successor first-alien))
"floater"
> (node-data (successor (successor first-alien)))
"thin man"

procedure
(predecessor n) → node?
n : node?

Given a node n contained in some tree, returns the immediate predecessor of n in an inorder traversal of that tree.

> (define partial-alien-tree (new-tree))
> (for ([name '("sectoid" "floater" "thin man" "chryssalid"
"muton" "cyberdisk")])
(insert-last/data! partial-alien-tree name))
> (define last-alien (tree-last partial-alien-tree))
> (node-data (predecessor last-alien))
"muton"
> (node-data (predecessor (predecessor last-alien)))
"chryssalid"

procedure
(tree-items t) → (listof/c (list/c any/c natural-number/c))
t : tree?

Given a tree, returns a list of its data and width pairs.

> (define t (new-tree))
> (insert-last/data! t "rock")
> (insert-last/data! t "paper")
> (insert-last/data! t "scissors")
> (tree-items t)
'("rock" "paper" "scissors")

procedure
(tree-fold-inorder t f acc) → any
  t : tree?
  f : (node? any/c . -> . any)
  acc : any/c
procedure
(tree-fold-preorder t f acc) → any
  t : tree?
  f : (node? any/c . -> . any)
  acc : any/c
procedure
(tree-fold-postorder t f acc) → any
  t : tree?
  f : (node? any/c . -> . any)
  acc : any/c

Iterates a function f across the nodes of the tree, in inorder, preorder, and postorder respectively.

> (define t (new-tree))
> (insert-last/data! t "three")
> (insert-last/data! t "blind")
> (insert-last/data! t "mice")
; "blind" should be the root, with
; "three" and "mice" as left and right.
> (define (f n acc) (cons (node-data n) acc))
> (reverse (tree-fold-inorder t f '()))
'("three" "blind" "mice")
> (reverse (tree-fold-preorder t f '()))
'("blind" "three" "mice")
> (reverse (tree-fold-postorder t f '()))
'("three" "mice" "blind")

2.2 Uncontracted library

This library uses contracts extensively to prevent the user from messing up; however, the contract checking may be prohibitively expensive for certain applications.

The uncontracted bindings of this library can be accessed through:

(require (submod data/red-black/augmented uncontracted))

3 Ordered sets: mutable sets with a total order

Danny Yoo <dyoo@hashcollision.org>

(require data/red-black/ordered-set)
	package: data-red-black

This module provides a mutable, set-like container of totally-ordered elements.

As a quick example:

> (require data/red-black/ordered-set)
> (define s1 (ordered-set))
> (for ([w (string-split
            (string-append "this is a test of the emergency broadcast"
                           " system this is only a test"))])
    (ordered-set-add! s1 w))
; Let's query for membership:
> (ordered-set-member? s1 "broadcast")
#t
> (ordered-set-member? s1 "radio")
#f
; The ordered set acts as a sequence:
> (for/list ([w s1]) w)
'("a" "broadcast" "emergency" "is" "of" "only" "system" "test" "the" "this")
> (ordered-set-remove! s1 "broadcast")
> (ordered-set-member? s1 "broadcast")
#f

For convenience, these ordered sets use the notion of the total-order defined by the datum-order function in data/order. The ordered-set constructor can take an optional #:order comparision function to customize how its elements compare.

But be careful about defining your own ordering function. The following example shows where it might go wrong:

; order-strings-by-length: string string -> (or/c '< '= '>)
> (define (order-strings-by-length x y)
    (define xs (string-length x))
    (define ys (string-length y))
    (cond [(< xs ys) '<]
          [(= xs ys) '=] ; (probably buggy. See below...)
          [(> xs ys) '>]))
> (define a-set (ordered-set #:order order-strings-by-length))
> (for ([word (string-split "we few we happy few we band of brothers")])
    (ordered-set-add! a-set word))
; Note that we know that "of" will be missing from the list!
; That's because the comparison function makes "of" and "we"
; look the same:
> (ordered-set->list a-set)
'("we" "few" "band" "happy" "brothers")

The ordered set trusts the order provided by #:order for all comparisons, including equality. In the example above, "of" and "we" compare the same, and ordered-set-add! ignores operations that insert a value that already exists in the set.

On the implementation side: an ordered set hold onto its elements with a red-black tree, so that most operations work in time logarithmic to the set’s ordered-set-count.

3.1 API

procedure
(ordered-set [#:order order] initial-elt ...) → ordered-set/c
order : (any/c any/c . -> . (or/c '< '= '>)) = datum-order
initial-elt : any/c

Constructs a new ordered set.

> (define my-set (ordered-set))
> my-set
#<ordered-set>
> (for/list ([x my-set]) x)
'()
; Creating an ordered set with initial elements:
> (define another-set (ordered-set 3 1 4 1 5 9))
> (for/list ([x another-set]) x)
'(1 3 4 5 9)

By default, this uses datum-order to compare its elements; this default can be overridden by providing an #:order that can compare two elements:

; Overriding #:order for descending sort:
> (define (cmp x y)
    (cond [(< x y) '>]
          [(= x y) '=]
          [(> x y) '<]))
> (define yet-another-set (ordered-set #:order cmp
                                       3 1 4 1 5 9))
> (for/list ([x yet-another-set]) x)
'(9 5 4 3 1)

procedure
(ordered-set? x) → boolean?
x : any/c

Returns true if x is an ordered set.

> (ordered-set? (ordered-set))
#t
> (ordered-set? (list 1 2 3))
#f
; The built in sets in Racket's racket/set library
; are not ordered sets:
> (ordered-set? (set))
#f

value
ordered-set/c : flat-contract?

A flat contract for ordered sets.

procedure
(ordered-set-order a-set)
→ (any/c any/c . -> . (or/c '< '= '>))
a-set : ordered-set/c

Returns the total-ordering function used by ordered set a-set.

> (define f (ordered-set-order (ordered-set)))
> (f 3 4)
'<
> (f 4 4)
'=
> (f 4 3)
'>

procedure
(ordered-set-empty? a-set) → boolean?
a-set : ordered-set/c

Returns true if the ordered set a-set is empty.

> (ordered-set-empty? (ordered-set))
#t
> (ordered-set-empty? (ordered-set 'nonempty "set!"))
#f

procedure
(ordered-set-count a-set) → natural-number/c
a-set : ordered-set/c

Returns the number of elements in the ordered set a-set.

> (ordered-set-count (ordered-set "duck" "duck" "goose"))
2

procedure
(ordered-set-member? a-set x) → boolean?
a-set : ordered-set/c
x : any/c

Returns true if x is an element in ordered set a-set.

> (define keywords (ordered-set "lambda" "case" "cond" "define"))
> (ordered-set-member? keywords "guitar")
#f
> (ordered-set-member? keywords "lambda")
#t

procedure
(ordered-set-add! a-set x) → void?
a-set : ordered-set/c
x : any/c

Adds x into ordered set a-set. If x is already an element, this has no effect.

> (define a-set (ordered-set))
> (ordered-set-add! a-set "racket")
> (ordered-set-add! a-set "prolog")
> (ordered-set-add! a-set "java")
> (ordered-set-add! a-set "ocaml")
> (for/list ([x a-set]) x)
'("java" "ocaml" "prolog" "racket")

Be aware that this operation depends on the correctness of the total-ordering function of a-set. If the order doesn’t distinguish between unequal elements, unexpected results may follow:

> (define (bad-cmp x y) '=)
> (define a-weird-set (ordered-set #:order bad-cmp))
> (ordered-set-add! a-weird-set "racket")
> (ordered-set-add! a-weird-set "prolog")
> (ordered-set-add! a-weird-set "java")
> (ordered-set-add! a-weird-set "ocaml")
> (for/list ([x a-weird-set]) x)
'("racket")

procedure
(ordered-set-remove! a-set x) → void?
a-set : ordered-set/c
x : any/c

Removes x from ordered set a-set. If x is not an element of a-set, this has no effect.

> (define leagues (ordered-set "gold" "silver" "bronze" "tin" "wood"))
> (ordered-set-member? leagues "tin")
#t
> (ordered-set-remove! leagues "tin")
> (ordered-set-member? leagues "tin")
#f

Just as with ordered-set-add!, ordered-set-remove!’s behavior depends on the correctness of the set’s total ordering function.

procedure
(ordered-set->list a-set) → list?
a-set : ordered-set/c

Returns the elements of ordered set a-set as a list, where the elements are sorted according to a-set’s total-order.

> (define cloud-types (ordered-set "cumulus" "stratus" "cirrus" "nimbus"))
> (ordered-set->list cloud-types)
'("cirrus" "cumulus" "nimbus" "stratus")

procedure
(in-ordered-set a-set) → sequence?
a-set : ordered-set/c

Explicitly constructs a sequence of the elements in ordered set a-set.

> (define a-sequence (in-ordered-set (ordered-set "a" "b" "b" "a")))
> a-sequence
#<sequence>
> (for ([x a-sequence]) (printf "I see: ~a\n" x))
I see: a
I see: b

Note that ordered sets are already treated implicitly as sequences.

> (for ([x (ordered-set "a" "b" "b" "a")]) (printf "I see: ~a\n" x))
I see: a
I see: b

4 Bibliography

Bibliography

[clrs2009]		Thomas H. Cormen, Charles E. Leiserson, Ronald L. Rivest, Clifford Stein, Introduction to Algorithms, Third Edition. 2009. http://mitpress.mit.edu/books/introduction-algorithms
[wein2005]		Ron Wein, “Efficient implementation of red-black trees with split and catenate operations.” 2005. http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.109.4875

top ← prev up next →

1	Positional Red-Black Trees
2	Augmented Red-Black Trees
3	Ordered sets: mutable sets with a total order
4	Bibliography