Algebraic data types: Difference between revisions

Line 4:

As an example, implement insertion in a [http://en.wikipedia.org/wiki/Red_Black_Tree red-black-tree]. A red-black-tree is a binary tree where each internal node has a color attribute ''red'' or ''black''. Moreover, no red node can have a red child, and every path from the root to an empty node must contain the same number of black nodes. As a consequence, the tree is balanced, and must be re-balanced after an insertion.

=={{header|Common Lisp}}==

A straighforward translation of the TCL solution. I don't know red-black-trees myself but I tried mirroring the original solution as closely as possible. It uses a pattern-matching library called [http://www.takeda.tk/~sthalik/stuff/toadstool-current.tar toadstool].

<lang lisp>(mapc #'use-package '(#:toadstool #:toadstool-system))

(defstruct (red-black-tree (:constructor tree (color left val right)))

color left val right)

(defcomponent tree (operator macro-mixin))

(defexpand tree (color left val right)

`(class red-black-tree red-black-tree-color ,color

red-black-tree-left ,left

red-black-tree-val ,val

red-black-tree-right ,right))

(pushnew 'tree *used-components*)

(defun balance (color left val right)

(toad-ecase color left val right

'black (tree 'red (tree 'red a x b) y c) z d

-> (tree 'red (tree 'black a x b) y

(tree 'black c z d))

'black (tree 'red a x (tree 'red b y c)) z d

-> (tree 'red (tree 'black a x b) y (tree 'black c z d))

'black a x (tree 'red (tree 'red b y c) z d)

-> (tree 'red (tree 'black a x b) y (tree 'black c z d))

'black a x (tree 'red b y (tree 'red c z d))

-> (tree 'red (tree 'black a x b) y (tree 'black c z d))

color a x b -> (tree color a x b)))

(defun %insert (x s)

(toad-ecase s

nil -> (tree 'red nil x nil)

(tree color a y b) -> (cond ((< x y)

(balance color (%insert x a) y b))

((> x y)

(balance color a y (%insert x b)))

(t s))))

(defun insert (x s)

(toad-ecase (%insert x s)

(tree t a y b) -> (tree 'black a y b)))</lang>

=={{Header|E}}==