Anonymous user
Algebraic data types: Difference between revisions
Added a Java (JDK 21 + Preview features) translation for the existing Kotlin solution. Removed the omission tag for Java.
(Added Tailspin solution) |
imported>Maruseron (Added a Java (JDK 21 + Preview features) translation for the existing Kotlin solution. Removed the omission tag for Java.) |
||
(34 intermediate revisions by 15 users not shown) | |||
Line 1:
{{task|
Some languages offer direct support for [[wp:Algebraic_data_type|algebraic data types]] and pattern matching on them. While this of course can always be simulated with manual tagging and conditionals, it allows for terse code which is easy to read, and can represent the algorithm directly.
Line 10:
<br><br>
;Reference:
[https://www.cs.tufts.edu/comp/150FP/archive/chris-okasaki/redblack99.pdf Red-Black Trees in a Functional Setting]
=={{header|Bracmat}}==
<
= a x b y c zd
. !arg
Line 58 ⟶ 60:
| insert$!arg
)
);</
Test:
<
, and can represent the algorithm directly
.
Line 69 ⟶ 71:
& lst$tree
& done
);</
Output:
<
B
. ( B
Line 93 ⟶ 95:
)
)
);</
=={{header|C++}}==
Line 100 ⟶ 102:
C++ templates have a robust pattern matching facility, with some warts - for example, nested templates cannot be fully specialized, so we must use a dummy template parameter. This implementation uses C++17 deduced template parameters for genericity.
<
template<Color, class, auto, class> struct T;
struct E;
Line 144 ⟶ 146:
int main() {
print<insert_t<1, insert_t<2, insert_t<0, insert_t<4, E>>>>>();
}</
===Run time===
Although C++ has structured bindings and pattern matching through function overloading, it is not yet possible to use them together so we must match the structure of the tree being rebalanced separately from decomposing it into its elements. A further issue is that function overloads are not ordered, so to avoid ambiguity we must explicitly reject any (ill-formed) trees that would match more than one case during rebalance.
<
#include <variant>
Line 251 ⟶ 253:
t = insert(std::string{argv[i]}, std::move(t));
print(t);
}</
=={{header|C sharp}}==
Translation of several
{{works with|C sharp|8}}
<
class Tree
Line 304 ⟶ 306:
_ => this
};
}</
{{out}}
<pre>
Line 354 ⟶ 356:
{{libheader|toadstool}}
<
(defstruct (red-black-tree (:constructor tree (color left val right)))
color left val right)
Line 392 ⟶ 394:
(defun insert (x s)
(toad-ecase1 (%insert x s)
((tree t a y b) (tree 'black a y b))))</
=={{header|E}}==
Line 439 ⟶ 441:
=={{header|EchoLisp}}==
<
;; code adapted from Racket and Common Lisp
;; Illustrates matching on structures
Line 467 ⟶ 469:
(match (ins x s) [(N _ l v r) (N '⚫️ l v r)]))
</syntaxhighlight>
{{out}}
<
(define (t-show n (depth 0))
(when (!eq? 'empty n)
Line 478 ⟶ 480:
(define T (for/fold [t 'empty] ([i 32]) (insert (random 100) t)))
(t-show T)
</syntaxhighlight>
<small>
<pre>
Line 513 ⟶ 515:
{{trans|Erlang}}
But, it changed an API into the Elixir style.
<
def find(nil, _), do: :not_found
def find({ key, value, _, _, _ }, key), do: { :found, { key, value } }
Line 555 ⟶ 557:
|> RBtree.insert(6,-1) |> IO.inspect
|> RBtree.insert(7,0) |> IO.inspect
|> RBtree.find(4) |> IO.inspect</
{{out}}
Line 576 ⟶ 578:
=={{header|Emacs Lisp}}==
The <code>pcase</code>
<syntaxhighlight lang="lisp">(defun rbt-balance (tree)
(pcase tree
(`(B (R (R ,a ,x ,b) ,y ,c) ,z ,d) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
Line 606 ⟶ 607:
(dotimes (i 16)
(setq s (rbt-insert (1+ i) s)))
(pp s))</syntaxhighlight>
Output:
Line 639:
The code used here is extracted from [https://gist.github.com/mjn/2648040 Mark Northcott's GitHubGist].
<
-module(rbtree).
-export([insert/3, find/2]).
Line 679:
balance(T) ->
T.
</syntaxhighlight>
Output:
Line 713:
</pre>
=={{header|F_Sharp|F#}}==
<syntaxhighlight lang="fsharp">
// Pattern Matching. Nigel Galloway: January 15th., 2021
type colour= |Red |Black
type rbT<'N>= |Empty |N of colour * rbT<'N> * rbT<'N> * 'N
let repair=function |Black,N(Red,N(Red,ll,lr,lv),rl,v),rr,rv
|Black,N(Red,ll,N(Red,lr,rl,v),lv),rr,rv
|Black,ll,N(Red,N(Red,lr,rl,v),rr,rv),lv
|Black,ll,N(Red,lr,N(Red,rl,rr,rv),v),lv->N(Red,N(Black,ll,lr,lv),N(Black,rl,rr,rv),v)
|i,g,e,l->N(i,g,e,l)
let insert item rbt = let rec insert=function
|Empty->N(Red,Empty,Empty,item)
|N(i,g,e,l) as node->if item>l then repair(i,g,insert e,l) elif item<l then repair(i,insert g,e,l) else node
match insert rbt with N(_,g,e,l)->N(Black,g,e,l) |_->Empty
</syntaxhighlight>
=={{header|Go}}==
{{trans|Kotlin}}
Line 719 ⟶ 734:
However, pattern matching on interfaces (via the type switch statement and type assertions) is limited to matching the implementing type and so the balance() method is not very pleasant.
<
import "fmt"
Line 836 ⟶ 851:
}
fmt.Println(tr)
}</
{{out}}
Line 845 ⟶ 860:
=={{header|Haskell}}==
<
data Tree a = E | T Color (Tree a) a (Tree a)
Line 862 ⟶ 877:
| x > y = balance col a y (ins b)
| otherwise = s
T _ a y b = ins s</
=={{header|J}}==
J incorporates a symbol data type which, in versions 6.02 and 7.01, J implements directly as a red-black tree. The [http://www.jsoftware.com/docs/help701/dictionary/dsco.htm s: entry in the J dictionary] begins
''Symbols are a data type and are created by the verb s:. Symbols provide a mechanism for searching, sorting, and comparisons more efficient than alternative mechanisms such as boxed strings. Structural, selection, and relational verbs work on symbols. Arithmetic verbs do not work on symbols.'' However, for this task we want to see an implementation and we want the implementation to represent an algebraic data type approach.
The following code
<syntaxhighlight lang="j">insert=:{{
'R';'';y;a:
:
if. 0=#y do. insert x
elseif. 0=L.y do. x insert insert y
else.
'C e K w'=. y
select. *x - K
case. _1 do. balance C;(x insert e);K;<w
case. 0 do. y
case. 1 do. balance C;e;K;<x insert w
end.
end.
}}
NB. C: color, e: east, K: key, w: west
NB. two cascaded reds under a black become two black siblings under a red
balance=: {{
'C e K w'=. y
if. #e do.
'eC ee eK ew'=. e
if. 'R'=eC do.
if. #ee do.
'eeC eee eeK eew'=. ee NB. ((eee eeK eew) eK ew) K w => (eee eeK eew) eK (ew K w)
if. 'R'=eeC do. 'R';('B';eee;eeK;<eew);eK;<'B';ew;K;<w return. end. end.
if. #ew do.
'ewC ewe ewK eww'=. ew NB. (ee ek (ewe ewK eww)) K w => (ee ek ewe) ewK (eww K w)
if. 'R'=ewC do. 'R';('B';ee;eK;<ewe);ewK;<'B';eww;K;<w return. end. end. end. end.
if. #w do.
'wC we wK ww'=. w
if. 'R'=wC do.
if. #we do.
'weC wee weK wew'=. we NB. e K ((wee weK wew) wK ww) => (e K wee) weK (wew wK ww)
if. 'R'=weC do. 'R';('B';e;K;<wee);weK;<'B';wew;wK;<ww return. end. end.
if. #ww do.
'wwC wwe wwK www'=. ww NB. e K (we wK (wwe wwK www)) => (e K we) wK (wwe wwK www)
if. 'R'=wwC do. 'R';('B';e;K;<we);wK;<'B';wwe;wwK;<www return. end. end. end. end.
y
}}</syntaxhighlight>
Example use:
<syntaxhighlight lang="j"> 3 insert 2 insert 5
┌─┬───────┬─┬───────┐
│R│┌─┬┬─┬┐│3│┌─┬┬─┬┐│
│ ││B││2│││ ││B││5│││
│ │└─┴┴─┴┘│ │└─┴┴─┴┘│
└─┴───────┴─┴───────┘</syntaxhighlight>
Note that by convention we treat the root node as black. This approach always labels it with 'R' which we ignore. However, if we wish to validate these trees, we must account for the discrepancy.
<syntaxhighlight lang="j">NB. always treat root of tree as black
validate=: {{
if. 0=#y do. 1 return. end.
'C e K w'=. y
check 'B';e;K;<w
}}
check=: {{
if. 0=#y do. 1 return. end.
'C e K w'=. y
if. 'R'=C do.
if. 'R'={.;{.e do. 0 return. end.
if. 'R'={.;{.w do. 0 return. end.
end.
a=. check e
b=. check w
(*a)*(a=b)*b+'B'=C
}}</syntaxhighlight>
Here, validate returns the effective "black depth" of the tree (treating the root node as black and treating empty nodes as black), or 0 if the tree is not balanced properly.
For example:
<syntaxhighlight lang="j"> ?.~20
14 18 12 16 5 1 3 0 6 13 9 8 15 17 2 10 7 4 19 11
insert/?.~20
┌─┬──────────────────────────────────────────────────────────────────────┬──┬────────────────────────────────────────────────────────────────────────┐
│R│┌─┬───────────────────────────────────┬─┬────────────────────────────┐│10│┌─┬────────────────────────────────────────────────┬──┬────────────────┐│
│ ││R│┌─┬──────────────┬─┬──────────────┐│5│┌─┬───────┬─┬──────────────┐││ ││B│┌─┬────────────────┬──┬────────────────────────┐│17│┌─┬────────┬──┬┐││
│ ││ ││B│┌─┬┬─┬───────┐│2│┌─┬───────┬─┬┐││ ││B│┌─┬┬─┬┐│7│┌─┬┬─┬───────┐│││ ││ ││R│┌─┬┬──┬────────┐│13│┌─┬────────┬──┬────────┐││ ││B│┌─┬┬──┬┐│19││││
│ ││ ││ ││B││0│┌─┬┬─┬┐││ ││B│┌─┬┬─┬┐│4││││ ││ ││B││6│││ ││B││8│┌─┬┬─┬┐││││ ││ ││ ││B││11│┌─┬┬──┬┐││ ││B│┌─┬┬──┬┐│15│┌─┬┬──┬┐│││ ││ ││R││18│││ ││││
│ ││ ││ ││ ││ ││R││1││││ ││ ││R││3│││ ││││ ││ │└─┴┴─┴┘│ ││ ││ ││R││9││││││ ││ ││ ││ ││ ││R││12││││ ││ ││R││14│││ ││R││16│││││ ││ │└─┴┴──┴┘│ ││││
│ ││ ││ ││ ││ │└─┴┴─┴┘││ ││ │└─┴┴─┴┘│ ││││ ││ │ │ ││ ││ │└─┴┴─┴┘││││ ││ ││ ││ ││ │└─┴┴──┴┘││ ││ │└─┴┴──┴┘│ │└─┴┴──┴┘│││ │└─┴────────┴──┴┘││
│ ││ ││ │└─┴┴─┴───────┘│ │└─┴───────┴─┴┘││ ││ │ │ │└─┴┴─┴───────┘│││ ││ ││ │└─┴┴──┴────────┘│ │└─┴────────┴──┴────────┘││ │ ││
│ ││ │└─┴──────────────┴─┴──────────────┘│ │└─┴───────┴─┴──────────────┘││ ││ │└─┴────────────────┴──┴────────────────────────┘│ │ ││
│ │└─┴───────────────────────────────────┴─┴────────────────────────────┘│ │└─┴────────────────────────────────────────────────┴──┴────────────────┘│
└─┴──────────────────────────────────────────────────────────────────────┴──┴────────────────────────────────────────────────────────────────────────┘
validate insert/?.~20
4</syntaxhighlight>
Finally a caution: red black trees exhibit poor cache coherency. In many (perhaps most or all) cases an amortized hierarchical linear sort mechanism will perform better than a red black tree implementation. (And that characteristic is especially true of this particular implementation.)
=={{header|Java}}==
{{trans|Kotlin}}
{{works with|OpenJDK|21 (Preview)}}
Java 21 has added support for ADTs (in the form of sealed types), which are narrowable through a switch expression. Despite having no fully-fledged pattern matching, a combination of record deconstruction patterns and guarded patterns allows for something very similar through switch expressions:
<syntaxhighlight lang="java">public class Task {
enum Color { R, B }
sealed interface Tree<A extends Comparable<A>> permits E, T {
default Tree<A> insert(A a) {
return switch(ins(a)) {
case T(_, var l, var v, var r) -> new T<>(Color.B, l, v, r);
case E() -> new E<>();
};
}
Tree<A> ins(A a);
}
record E<A extends Comparable<A>>() implements Tree<A> {
@Override
public Tree<A> ins(A a) {
return new T<>(Color.R, new E<>(), a, new E<>());
}
@Override
public String toString() { return "E"; }
}
record T<A extends Comparable<A>>(Color color, Tree<A> left,
A value, Tree<A> right) implements Tree<A> {
@Override
public Tree<A> ins(A a) {
return switch(Integer.valueOf(a.compareTo(value))) {
case Integer i when i < 0 -> new T<>(color, left.ins(a), value, right).balance();
case Integer i when i > 0 -> new T<>(color, left, value, right.ins(a)).balance();
default -> this;
};
}
private Tree<A> balance() {
case T<A>(_, T<A>(_, T<A>(_, var a, var x, var b), var y, var c), var z, var d)
when left instanceof T<A> le && le.left instanceof T<A> le_le &&
le.color == Color.R && le_le.color == Color.R ->
new T<>(Color.R, new T<>(Color.B, a, x, b), y, new T<>(Color.B, c, z, d));
case T<A>(_, T<A>(_, var a, var x, T<A>(_, var b, var y, var c)), var z, var d)
when left instanceof T<A> le && le.right instanceof T<A> le_ri &&
le.color == Color.R && le_ri.color == Color.R ->
new T<>(Color.R, new T<>(Color.B, a, x, b), y, new T<>(Color.B, c, z, d));
case T<A>(_, var a, var x, T<A>(_, T<A>(_, var b, var y, var c), var z, var d))
when right instanceof T<A> ri && ri.left instanceof T<A> ri_le &&
ri.color == Color.R && ri_le.color == Color.R ->
new T<>(Color.R, new T<>(Color.B, a, x, b), y, new T<>(Color.B, c, z, d));
case T<A>(_, var a, var x, T<A>(_, var b, var y, T<A>(_, var c, var z, var d)))
when right instanceof T<A> ri && ri.right instanceof T<A> ri_ri &&
ri.color == Color.R && ri_ri.color == Color.R ->
new T<>(Color.R, new T<>(Color.B, a, x, b), y, new T<>(Color.B, c, z, d));
default -> this;
};
}
@Override
public String toString() {
return STR."T[\{color}, \{left}, \{value}, \{right}]"; // String templates are a JDK 21 Preview feature
}
}
public static void main(String[] args) {
Tree<Integer> tree = new E<>();
for (var i : IntStream.rangeClosed(1, 16).toArray()) {
tree = tree.insert(i);
System.out.println(tree);
}
}
</syntaxhighlight>
{{out}}
<pre>
T[B, T[B, T[B, T[B, E, 1, E], 2, T[B, E, 3, E]], 4, T[B, T[B, E, 5, E], 6, T[B, E, 7, E]]], 8, T[B, T[B, T[B, E, 9, E], 10, T[B, E, 11, E]], 12, T[B, T[B, E, 13, E], 14, T[B, E, 15, T[R, E, 16, E]]]]]
</pre>
=={{header|jq}}==
'''Adapted from [[#Tcl|Tcl]]'''
{{works with|jq}}
'''Works with gojq, the Go implementation of jq'''
jq does not have built-in support for pattern matching in the sense of the present task description, but the following `bindings` function takes advantage of the way in which singleton-key JSON objects can be used as variables for pattern-matching. In effect, jq expressions such as `{a}`
can be used as variables in the pattern definitions, and after matching, the corresponding values can be referenced by jq expressions such as `.a`.
Notice also how various features of jq come together to simplify the implementation of the `balance` function.
'''bindings.jq'''
<syntaxhighlight lang="jq"># bindings($x) attempts to match . and $x structurally on the
# assumption that . is free of JSON objects, and that any objects in
# $x will have distinct, singleton keys that are to be interpreted as
# variables. These variables will match the corresponding entities in
# . if . and $x can be structurally matched.
#
# If . and $x cannot be matched, then null is returned;
# otherwise, if $x contains no objects, {} is returned;
# finally, if . and $x can be structurally matched, a composite object containing the bindings
# will be returned.
# Output: null (failure to match) or a single JSON object giving the bindings if any.
def bindings($x):
if $x == . then {} # by assumption, no bindings are necessary
elif ($x|type) == "object"
then ($x|keys) as $keys
| if ($keys|length) == 1 then {($keys[0]): .} else "objects should be singletons"|error end
elif type != ($x|type) then null
elif type == "array"
then if length != ($x|length) then null
else . as $in
| reduce range(0;length) as $i ({};
if . == null then null
else ($in[$i] | bindings($x[$i]) ) as $m
| if $m == null then null else . + $m end
end)
end
else null
end ;</syntaxhighlight>
'''pattern-matching.jq'''
<syntaxhighlight lang="jq">include "bindings" {search: "."};
def E: []; # the empty node
# Each nonempty node is an array: [Color, Left, Value, Right]
# where Left and Right are nodes.
def B: "⚫";
def R: "🔴";
def b(x): bindings({} | x) // empty;
# Input: [$color, $left, $value, $right]
def balance:
def node: [R, [B, .a, .x, .b], .y, [B, .c, .z, .d]];
( b([B, [R, [R, {a}, {x}, {x}], {y}, {c}], {z}, {d}])
// b([B, [R, {a}, {x}, [R, {b}, {y}, {c}]], {z}, {d}])
// b([B, {a},{x}, [R, [R, {b}, {y}, {c}], {z}, {d}]])
// b([B, {a},{x}, [R, {b}, {y}, [R, {c}, {z}, {d}]]])
| node) // . ;
# Input: a node
def ins($x):
if . == E then [R, E, $x, E]
else . as [$col, $left, $y, $right]
| if $x < $y then [ $col, ($left|ins($x)), $y, $right] | balance
elif $x > $y then [ $col, $left, $y, ($right|ins($x)) ] | balance
else $left
end
end;
# insert(Value) into .
def insert($x):
ins($x) as [$col, $left, $y, $right]
| [ B, $left, $y, $right] ;
def pp: walk( if type == "array" then map(select(length>0)) else . end);
def task($n):
reduce range(0; $n) as $i (E; insert($i));
task(16) | pp</syntaxhighlight>
{{out}}
For brevity and perhaps visual appeal, the output from jq has been trimmed as per the following invocation:
<syntaxhighlight lang="sh">jq -n -f pattern-matching.jq | grep -v '[][]' | tr -d ',"'</syntaxhighlight>
<pre>
⚫
⚫
⚫
⚫
1
⚫
2
3
⚫
⚫
4
5
⚫
6
7
⚫
⚫
⚫
8
9
⚫
10
11
⚫
⚫
12
13
⚫
14
🔴
15
</pre>
=={{header|Julia}}==
Julia's multiple dispatch model is based on the types of a function's arguments, but does not look deeper into the function's array arguments for the types of their contents. Therefore we do multi-dispatch on the balance function but then use an if statement within the multiply dispatched functions to further match based on argument vector contents.
<
abstract type AbstractColoredNode end
Line 1,154 ⟶ 1,253:
testRB()
</
<pre>
[B, [R, [B, [R, E, 1, E], 2, [R, E, 3, E]], 4, [B, E, 6, E]], 14, [B, E, 18, E]]]
Line 1,164 ⟶ 1,263:
Whilst Kotlin supports algebraic data types (via 'sealed classes') and destructuring of data classes, pattern matching on them (via the 'when' expression) is currently limited to matching the type. Consequently the balance() function is not very pretty!
<
import Color.*
Line 1,247 ⟶ 1,346:
}
println(tree)
}</
{{out}}
Line 1,253 ⟶ 1,352:
T(B, T(B, T(B, T(B, E, 1, E), 2, T(B, E, 3, E)), 4, T(B, T(B, E, 5, E), 6, T(B, E, 7, E))), 8, T(B, T(B, T(B, E, 9, E), 10, T(B, E, 11, E)), 12, T(B, T(B, E, 13, E), 14, T(B, E, 15, T(R, E, 16, E)))))
</pre>
=={{header|Nim}}==
{{libheader|fusion/matching}}
<syntaxhighlight lang="nim">import fusion/matching
{.experimental: "caseStmtMacros".}
type
Colour = enum Empty, Red, Black
RBTree[T] = ref object
colour: Colour
left, right: RBTree[T]
value: T
proc `[]`[T](r: RBTree[T], idx: static[FieldIndex]): auto =
## enables tuple syntax for unpacking and matching
when idx == 0: r.colour
elif idx == 1: r.left
elif idx == 2: r.value
elif idx == 3: r.right
template B[T](l: untyped, v: T, r): RBTree[T] =
RBTree[T](colour: Black, left: l, value: v, right: r)
template R[T](l: untyped, v: T, r): RBTree[T] =
RBTree[T](colour: Red, left: l, value: v, right: r)
template balImpl[T](t: typed): untyped =
case t
of (colour: Red | Empty): discard
of (Black, (Red, (Red, @a, @x, @b), @y, @c), @z, @d) |
(Black, (Red, @a, @x, (Red, @b, @y, @c)), @z, @d) |
(Black, @a, @x, (Red, (Red, @b, @y, @c), @z, @d)) |
(Black, @a, @x, (Red, @b, @y, (Red, @c, @z, @d))):
t = R(B(a, x, b), y, B(c, z, d))
proc balance*[T](t: var RBTree[T]) = balImpl[T](t)
template insImpl[T](t, x: typed): untyped =
template E: RBTree[T] = RBTree[T]()
case t
of (colour: Empty): t = R(E, x, E)
of (value: > x): t.left.ins(x); t.balance()
of (value: < x): t.right.ins(x); t.balance()
proc insert*[T](tt: var RBTree[T], xx: T) =
proc ins(t: var RBTree[T], x: T) = insImpl[T](t, x)
tt.ins(xx)
tt.colour = Black</syntaxhighlight>
=={{header|OCaml}}==
<
type color = R | B
type 'a tree = E | T of color * 'a tree * 'a * 'a tree
Line 1,280 ⟶ 1,426:
in let T (_,a,y,b) = ins s
in T (B,a,y,b)
</syntaxhighlight>
=={{header|Oz}}==
Line 1,288 ⟶ 1,434:
To match multiple variables at once, we create temporary tuples with "#".
<
case Col#A#X#B
of b#t(r t(r A X B) Y C )#Z#D then t(r t(b A X B) Y t(b C Z D))
Line 1,311 ⟶ 1,457:
in
t(b A Y B)
end</
=={{header|Perl}}==
Line 1,324 ⟶ 1,470:
Each of the single letter variables declared right after $balanced, match an instance of $balanced, and if they succeed, store the result into the %+ hash.
<
use 5.010;
use strict;
Line 1,389 ⟶ 1,535:
}
print "Done\n";
</syntaxhighlight>
{{out}}
<pre>Tree: <B,_,9,_>.
Line 1,406 ⟶ 1,552:
There is no formal support for this sort of thing in Phix, but that's not to say that whipping
something up is likely to be particularly difficult, so let's give it a whirl.
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #000080;font-style:italic;">--
-- =================================
--
-- 1). Lightly modified copy of demo\rosetta\VisualiseTree.exw</span>
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #000080;font-style:italic;">-- To the theme tune of the Milk Tray Ad iyrt,
-- All because the Windows console hates utf8:</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">TL</span> <span style="color: #0000FF;">=</span> '\<span style="color: #000000;">#DA</span>'<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- aka '┌'</span>
<span style="color: #000000;">VT</span> <span style="color: #0000FF;">=</span> '\<span style="color: #000000;">#B3</span>'<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- aka '│'</span>
<span style="color: #000000;">BL</span> <span style="color: #0000FF;">=</span> '\<span style="color: #000000;">#C0</span>'<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- aka '└'</span>
<span style="color: #000000;">HZ</span> <span style="color: #0000FF;">=</span> '\<span style="color: #000000;">#C4</span>'<span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- aka '─'</span>
<span style="color: #000000;">HS</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"\#C4"</span> <span style="color: #000080;font-style:italic;">-- (string version of HZ)</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">w1252_to_utf8</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()!=</span><span style="color: #004600;">WINDOWS</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">substitute_all</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,{</span> <span style="color: #000000;">TL</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">VT</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">BL</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">HZ</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"┌"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"│"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"└"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"─"</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #000080;font-style:italic;">--</hates utf8></span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">visualise_tree</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">root</span><span style="color: #0000FF;">=</span><span style="color: #000000;">HS</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">atom</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"<empty>\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">else</span>
<span style="color: #004080;">object</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">colour</span><span style="color: #0000FF;">,</span><span style="color: #000000;">left</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">,</span><span style="color: #000000;">right</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">g</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">root</span><span style="color: #0000FF;">[$]</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">sequence</span><span style="color: #0000FF;">(</span><span style="color: #000000;">left</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">root</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">g</span><span style="color: #0000FF;">=</span><span style="color: #000000;">TL</span> <span style="color: #008080;">or</span> <span style="color: #000000;">g</span><span style="color: #0000FF;">=</span><span style="color: #000000;">HZ</span><span style="color: #0000FF;">?</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">:</span><span style="color: #000000;">VT</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">visualise_tree</span><span style="color: #0000FF;">(</span><span style="color: #000000;">left</span><span style="color: #0000FF;">,</span><span style="color: #000000;">root</span><span style="color: #0000FF;">&</span><span style="color: #000000;">TL</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">root</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">g</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s%s%v\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">w1252_to_utf8</span><span style="color: #0000FF;">(</span><span style="color: #000000;">root</span><span style="color: #0000FF;">),</span><span style="color: #000000;">colour</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">sequence</span><span style="color: #0000FF;">(</span><span style="color: #000000;">right</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">root</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">g</span><span style="color: #0000FF;">=</span><span style="color: #000000;">TL</span><span style="color: #0000FF;">?</span><span style="color: #000000;">VT</span><span style="color: #0000FF;">:</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">visualise_tree</span><span style="color: #0000FF;">(</span><span style="color: #000000;">right</span><span style="color: #0000FF;">,</span><span style="color: #000000;">root</span><span style="color: #0000FF;">&</span><span style="color: #000000;">BL</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000080;font-style:italic;">--</copy VisualiseTree>
-- 2). Imagine the following is in a file, say algebraic_data_types.e - not quite generic enough
-- for inclusion in builtins, but not exactly difficult to copy/maintain per-project either.</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">match_one</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">key</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">sequence</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">and</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">key</span><span style="color: #0000FF;">)==</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">key</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">ki</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">key</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span> <span style="color: #000000;">ti</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #004080;">sequence</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ki</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">and</span> <span style="color: #008080;">not</span> <span style="color: #004080;">string</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ki</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">r2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">match_one</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ki</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ti</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">r2</span><span style="color: #0000FF;">={}</span> <span style="color: #008080;">then</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">r2</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ki</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ti</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ki</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">ti</span> <span style="color: #008080;">then</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #000080;font-style:italic;">/*global*/</span> <span style="color: #008080;">function</span> <span style="color: #000000;">match_algebraic</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">set</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">match_one</span><span style="color: #0000FF;">(</span><span style="color: #000000;">set</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #000080;font-style:italic;">--</algebraic_data_types.e>
-- 3). The actual task</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">B</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"B"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">R</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"R"</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">balance</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">match_algebraic</span><span style="color: #0000FF;">({{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}},</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}}}},</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">object</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">z</span><span style="color: #0000FF;">,</span><span style="color: #000000;">d</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span>
<span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">},</span><span style="color: #000000;">y</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">z</span><span style="color: #0000FF;">,</span><span style="color: #000000;">d</span><span style="color: #0000FF;">}}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">t</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">tree</span><span style="color: #0000FF;">=</span><span style="color: #004600;">NULL</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #004600;">NULL</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">,</span><span style="color: #004600;">NULL</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">else</span>
<span style="color: #004080;">object</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">l</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">,</span><span style="color: #000000;">r</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">k</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;"><</span><span style="color: #000000;">k</span> <span style="color: #008080;">then</span> <span style="color: #000000;">l</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #000000;">l</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">else</span> <span style="color: #000000;">r</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #000000;">r</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">balance</span><span style="color: #0000FF;">({</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">l</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">,</span><span style="color: #000000;">r</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">tree</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">tree</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">B</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">tree</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">stuff</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">shuffle</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">10</span><span style="color: #0000FF;">))</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">NULL</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">stuff</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span><span style="color: #000000;">stuff</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000000;">visualise_tree</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">?</span><span style="color: #008000;">"done"</span>
<span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">wait_key</span><span style="color: #0000FF;">()</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 1,498 ⟶ 1,692:
└B9
└R10
</pre>
=={{header|Picat}}==
{{trans|Prolog}}
<syntaxhighlight lang="picat">main =>
T = e,
foreach (X in 1..10)
insert(X,T,T1),
T := T1
end,
output(T,0).
insert(X,S,R) =>
ins(X,S,R1),
R1 = $t(_,A,Y,B),
R = $t(b,A,Y,B).
ins(X,e,R) => R = $t(r,e,X,e).
ins(X,t(C,A,Y,B),R), X < Y => ins(X,A,Ao), balance(C,Ao,Y,B,R).
ins(X,t(C,A,Y,B),R), X > Y => ins(X,B,Bo), balance(C,A,Y,Bo,R).
ins(_X,T,R) => R = T.
balance(C,A,X,B,S) :- (bal(C,A,X,B,T) -> S = T ; S = $t(C,A,X,B)).
bal(b, t(r,t(r,A,X,B),Y,C), Z, D, R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
bal(b, t(r,A,X,t(r,B,Y,C)), Z, D, R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
bal(b, A, X, t(r,t(r,B,Y,C),Z,D), R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
bal(b, A, X, t(r,B,Y,t(r,C,Z,D)), R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
output(e,Indent) => printf("%*w\n",Indent,e).
output(t(C,A,Y,B),Indent) =>
output(A,Indent+6),
printf("%*w[%w]\n",Indent,C,Y),
output(B,Indent+6).
</syntaxhighlight>
{{out}}
<pre>
e
b[1]
e
b[2]
e
b[3]
e
b[4]
e
b[5]
e
b[6]
e
b[7]
e
r[8]
e
b[9]
e
r[10]
e
</pre>
=={{header|PicoLisp}}==
{{trans|Prolog}}
<
(be color (B))
Line 1,536 ⟶ 1,788:
(be insert (@X @S (T B @A @Y @B))
(ins @X @S (T @ @A @Y @B)) )</
Test:
<
@A=(T B E 2 E) @B=(T B (T R E 1 E) 2 E) @C=(T B (T R E 1 E) 2 (T R E 3 E))
-> NIL</
=={{header|Prolog}}==
Line 1,564 ⟶ 1,816:
insert(X,S,t(b,A,Y,B)) :- ins(X,S,t(_,A,Y,B)).
</pre>
=={{header|Python}}==
{{trans|C#}}
Structural pattern matching was added to Python in version 3.10.
<syntaxhighlight lang="python">from __future__ import annotations
from enum import Enum
from typing import NamedTuple
from typing import Optional
class Color(Enum):
B = 0
R = 1
class Tree(NamedTuple):
color: Color
left: Optional[Tree]
value: int
right: Optional[Tree]
def insert(self, val: int) -> Tree:
return self._insert(val).make_black()
def _insert(self, val: int) -> Tree:
match compare(val, self.value):
case _ if self == EMPTY:
return Tree(Color.R, EMPTY, val, EMPTY)
case -1:
assert self.left is not None
return Tree(
self.color, self.left._insert(val), self.value, self.right
).balance()
case 1:
assert self.right is not None
return Tree(
self.color, self.left, self.value, self.right._insert(val)
).balance()
case _:
return self
def balance(self) -> Tree:
match self:
case (Color.B, (Color.R, (Color.R, a, x, b), y, c), z, d):
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
case (Color.B, (Color.R, a, x, (Color.R, b, y, c)), z, d):
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
case (Color.B, a, x, (Color.R, (Color.R, b, y, c), z, d)):
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
case (Color.B, a, x, (Color.R, b, y, (Color.R, c, z, d))):
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
case _:
return self
def make_black(self) -> Tree:
return self._replace(color=Color.B)
def __str__(self) -> str:
if self == EMPTY:
return "[]"
return f"[{'R' if self.color == Color.R else 'B'}{self.value}]"
def print(self, indent: int = 0) -> None:
if self != EMPTY:
assert self.right is not None
self.right.print(indent + 1)
print(f"{' ' * indent * 4}{self}")
if self != EMPTY:
assert self.left is not None
self.left.print(indent + 1)
EMPTY = Tree(Color.B, None, 0, None)
def compare(x: int, y: int) -> int:
if x > y:
return 1
if x < y:
return -1
return 0
def main():
tree = EMPTY
for i in range(1, 17):
tree = tree.insert(i)
tree.print()
if __name__ == "__main__":
main()
</syntaxhighlight>
{{out}}
<pre>
[]
[R16]
[]
[B15]
[]
[B14]
[]
[B13]
[]
[B12]
[]
[B11]
[]
[B10]
[]
[B9]
[]
[B8]
[]
[B7]
[]
[B6]
[]
[B5]
[]
[B4]
[]
[B3]
[]
[B2]
[]
[B1]
[]
</pre>
Line 1,569 ⟶ 1,955:
{{trans|OCaml}}
<
#lang racket
Line 1,602 ⟶ 1,988:
(visualize (for/fold ([t 'empty]) ([i 16]) (insert i t)))
</syntaxhighlight>
<pre>
Line 1,627 ⟶ 2,013:
{{works with|rakudo|2016.11}}
Raku doesn't have algebraic data types (yet), but it does have pretty good pattern matching in multi signatures.
<syntaxhighlight lang="raku"
multi balance(B,[R,[R,$a,$x,$b],$y,$c],$z,$d) { [R,[B,$a,$x,$b],$y,[B,$c,$z,$d]] }
Line 1,651 ⟶ 2,037:
$t = insert($_, $t) for (1..10).pick(*);
say $t.gist;
}</
This code uses generic comparison operators <tt>before</tt> and <tt>after</tt>, so it should work on any ordered type.
{{out}}
Line 1,663 ⟶ 2,049:
An abstract pattern is recursively defined and may contain, among others, the following elements: Literal, VariableDeclaration, MultiVariable, Variable, List, Set, Tuple, Node, Descendant, Labelled, TypedLabelled, TypeConstrained. More explanation can be found in the [http://http://tutor.rascal-mpl.org/Courses/Rascal/Rascal.html#/Courses/Rascal/Patterns/Abstract/Abstract.html Documentation]. Some examples:
<
// Literal
rascal>123 := 123
Line 1,728 ⟶ 2,114:
Match black(leaf(3),leaf(4))
Match black(leaf(5),leaf(4))
list[void]: []</
===Concrete===
Line 1,735 ⟶ 2,121:
A concrete pattern is a quoted concrete syntax fragment that may contain variables. The syntax that is used to parse the concrete pattern may come from any module that has been imported in the module in which the concrete pattern occurs. Some examples of concrete patterns:
<
` Token1 Token2 ... Tokenn `
// A typed quoted pattern
Line 1,742 ⟶ 2,128:
<Type Var>
// A variable pattern
<Var></
A full example of concrete patterns can be found in the [http://tutor.rascal-mpl.org/Courses/Recipes/Languages/Exp/Concrete/WithLayout/WithLayout.html Rascal Recipes].
Line 1,750 ⟶ 2,136:
There are two variants of the PatternsWitchAction. When the subject matches Pattern, the expression Exp is evaluated and the subject is replaced with the result. Secondly, when the subject matches Pattern, the (block of) Statement(s) is executed. See below for some ColoredTree examples:
<
data ColoredTree = leaf(int N)
| red(ColoredTree left, ColoredTree right)
Line 1,789 ⟶ 2,175:
case red(l, r) => green(l, r)
};
}</
===Regular Expressions===
Line 1,795 ⟶ 2,181:
Regular expressions are noated between two slashes. Most normal regular expressions patterns are available, such as ., \n, \d, etc. Additionally, flags can be used to create case intensiveness.
<
bool: true
rascal>/a.c/ := "abc";
bool: true</
=={{header|REXX}}==
The nodes used for this example are taken from the Wikipedia example at:
[[https://en.wikipedia.org/wiki/Red%E2%80%93black_tree#/media/File:Red-black_tree_example.svg red black tree, an example]]
<
parse arg nodes '/' insert /*obtain optional arguments from the CL*/
if nodes='' then nodes = 13.8.17 8.1.11 17.15.25 1.6 25.22.27 /*default nodes. */
Line 1,840 ⟶ 2,226:
if @.y\==. & @.y\=='' then call err "node is already defined: " y
end /*v*/
return</
{{out|output|text= when using the default inputs:}}
<pre>
Line 1,854 ⟶ 2,240:
{{trans|Haskell}}
This would be a horribly inefficient way to implement a Red-Black Tree in Rust as nodes are being allocated and deallocated constantly, but it does show off Rust's pattern matching.
<
use self::Color::*;
use std::cmp::Ordering::*;
Line 1,896 ⟶ 2,282:
}
}
}</
=={{header|Scala}}==
Line 1,931 ⟶ 2,317:
of that object.
<
sealed abstract class Color
case object R extends Color
Line 1,963 ⟶ 2,349:
}
}
}</
Usage example:
Line 1,980 ⟶ 2,366:
=={{header|Standard ML}}==
<
datatype color = R | B
datatype 'a tree = E | T of color * 'a tree * 'a * 'a tree
Line 2,005 ⟶ 2,391:
T (B,a,y,b)
end
</syntaxhighlight>
=={{header|Swift}}==
{{works with|Swift|2+}}
<
enum Tree<A> {
case E
Line 2,045 ⟶ 2,431:
return .E
}
}</
=={{header|Tailspin}}==
{{trans|Haskell}}
Tailspin doesn't have
<syntaxhighlight lang="tailspin">
processor RedBlackTree
data node <{VOID}|{colour: <='black'|='red'>, left: <node>, right: <node>, value: <> VOID}> local
@: {};
sink insert
Line 2,062 ⟶ 2,448:
value: $.left.value,
right: { $..., left: $.left.right }} !
when <{colour: <='black'>, left: <{ colour: <='red'> right: <{colour: <='red'>}>}>}>
do { colour: 'red',
left: { $.left..., colour: 'black', right: $.left.right.left},
Line 2,081 ⟶ 2,466:
end balance
templates ins&{into:}
when <?($into <´node´ ={}>)> do { colour: 'red', left: {}, value: $, right: {}} !
when <..$into.value::raw> do { $into..., left: $ -> ins&{into: $into.left}} -> balance !
otherwise { $into..., right: $ -> ins&{into: $into.right}} -> balance !
end ins
Line 2,095 ⟶ 2,480:
1..5 -> \('$tree::toString;$#10;' -> !OUT::write $ -> !tree::insert \) -> !VOID
$tree::toString -> !OUT::write
</syntaxhighlight>
{{out}}
<pre>
Line 2,110 ⟶ 2,495:
Tcl doesn't have algebraic types built-in, but they can be simulated using tagged lists, and a custom pattern matching control structure can be built:
<
package require Tcl 8.5
package provide datatype 0.1
Line 2,180 ⟶ 2,565:
proc default body { return -code return [list {} $body] }
}
</syntaxhighlight>
We can then code our solution similar to Haskell:
<
datatype define Tree = E | T color left val right
Line 2,212 ⟶ 2,597:
}
}
}</
=={{header|TXR}}==
TXR Lisp has structural pattern matching on objects of all kinds, including structures. We define a red-black tree structure like this, with a BOA constructor (by-order of arguments) for convenience:
<syntaxhighlight lang="txrlisp">
(defstruct (rbnode color left right data) ()
color
left
right
data)
</syntaxhighlight>
The empty tree case is handled by the <code>nil</code> symbol, so in terms of algebraic types, the tree is a sum of <code>nil</code> and the <code>rbnode</code> struct type, and that struct type is a product type of several properties. For the <code>color</code> slot, we use the keyword symbols <code>:red</code> and <code>:black</code> which needs not be declared anywhere. <code>data</code> can be any value.
TXR Lisp's syntax for matching structures looks like this:
<syntaxhighlight lang="txrlisp">
@(struct time year @y month @m)
</syntaxhighlight>
This example matches a time structure instance, capturing the year as <code>y</code>
and month as <code>m</code>.
Structures aren't ordered tuples; they are clumps of of named slots,
that cannot be accessed by position. This would break under
inheritance, in particular multiple inheritance.
Furthermore, variables have the <code>@</code> sigil in most pattern matching
constructs, because symbols without the sigil denote themselves as literal
patterns. The pattern <code>x</code> matches the symbol <code>x</code>
literally, and no other object. The pattern <code>@x</code> matches any
object and captures it as <code>x</code>.
These above features make it verbose and somewhat noisy to express
pattern matching of our <code>rbtree</code> node. However, TXR Lisp's
pattern matching sublanguage supports application-defined macro patterns,
defined by the <code>defmatch</code> macro. With these we can achieve
a shorthand notation which matches nodes as if they were ordered tuples,
and which drops the sigils from variables.
<syntaxhighlight lang="txrlisp">
(defmatch rb (color left right data)
(flet ((var? (sym) (if (bindable sym) ^@,sym sym)))
^@(struct rbnode
color ,(var? color)
left ,(var? left)
right ,(var? right)
data ,(var? data))))
(defmatch red (left right data)
^@(rb :red ,left ,right ,data))
(defmatch black (left right data)
^@(rb :black ,left ,right ,data))
</syntaxhighlight>
And with all the above, we can write the code like this:
<syntaxhighlight lang="txrlisp">
(defun-match rb-balance
((@(or @(black @(red @(red a b x) c y) d z)
@(black @(red a @(red b c x) x) d z)
@(black a @(red @(red b c y) d z) x)
@(black a @(red b @(red c d z) y) x)))
(new (rbnode :red
(new (rbnode :black a b x))
(new (rbnode :black c d z))
y)))
((@else) else))
(defun rb-insert-rec (tree x)
(match-ecase tree
(nil
(new (rbnode :red nil nil x)))
(@(rb color a b y)
(cond
((< x y)
(rb-balance (new (rbnode color (rb-insert-rec a) b y))))
((> x y)
(rb-balance (new (rbnode color a (rb-insert-rec b) y))))
(t tree)))))
(defun rb-insert (tree x)
(match-case (rb-insert-rec tree x)
(@(red a b y) (new (rbnode :black a b y)))
(@else else)))
</syntaxhighlight>
Insertion is split into two functions: a recursive one which works on its own, except that whenever the tree ends up with a red root, we would like to rewrite that node to a black one. We make the insertion function call the recursive one and then do this fix-up using pattern matching again.
=={{header|Wren}}==
{{trans|Go}}
Wren doesn't have either algebraic data types or pattern matching though, despite that, the ''T.balance()'' method looks better than I thought it would :)
<syntaxhighlight lang="wren">var R = "R"
var B = "B"
class Tree {
ins(x) {} // overridden by child classes
insert(x) { // inherited by child classes
var t = ins(x)
if (t.type == T) return T.new(B, t.le, t.aa, t.ri)
if (t.type == E) return E.new()
return null
}
}
class T is Tree {
construct new(cl, le, aa, ri) {
_cl = cl // color
_le = le // Tree
_aa = aa // integer
_ri = ri // Tree
}
cl { _cl }
le { _le }
aa { _aa }
ri { _ri }
balance() {
if (_cl != B) return this
var le2 = _le.type == T ? _le : null
var lele
var leri
if (le2) {
lele = _le.le.type == T ? _le.le : null
leri = _le.ri.type == T ? _le.ri : null
}
var ri2 = _ri.type == T ? _ri : null
var rile
var riri
if (ri2) {
rile = _ri.le.type == T ? _ri.le : null
riri = _ri.ri.type == T ? _ri.ri : null
}
if (le2 && lele && le2.cl == R && lele.cl == R) {
var t = le2.le
return T.new(R, T.new(B, t.le, t.aa, t.ri), le2.aa, T.new(B, le2.ri, _aa, _ri))
}
if (le2 && leri && le2.cl == R && leri.cl == R) {
var t = le2.ri
return T.new(R, T.new(B, le2.le, le2.aa, t.le), t.aa, T.new(B, t.ri, _aa, _ri))
}
if (ri2 && rile && ri2.cl == R && rile.cl == R) {
var t = ri2.ri
return T.new(R, T.new(B, _le, _aa, t.le), t.aa, T.new(B, t.ri, ri2.aa, ri2.ri))
}
if (ri2 && riri && ri2.cl == R && riri.cl == R) {
var t = ri2.ri
return T.new(R, T.new(B, _le, _aa, ri2.le), ri2.aa, T.new(B, t.le, t.aa, t.ri))
}
return this
}
ins(x) {
if (x < _aa) return T.new(_cl, _le.ins(x), _aa, _ri).balance()
if (x > _aa) return T.new(_cl, _le, _aa, _ri.ins(x)).balance()
return this
}
toString { "T(%(_cl), %(_le), %(_aa), %(_ri))" }
}
class E is Tree {
construct new() {}
ins(x) { T.new(R, E.new(), x, E.new()) }
toString { "E" }
}
var tr = E.new()
for (i in 1..16) tr = tr.insert(i)
System.print(tr)</syntaxhighlight>
{{out}}
<pre>
T(B, T(B, T(B, T(B, E, 1, E), 2, T(B, E, 3, E)), 4, T(B, T(B, E, 5, E), 6, T(B, E, 7, E))), 8, T(B, T(B, T(B, E, 9, E), 10, T(B, E, 11, E)), 12, T(B, T(B, E, 13, E), 14, T(B, E, 15, T(R, E, 16, E)))))
</pre>
{{omit from|Ada}}
{{omit from|BBC BASIC}}
{{omit from|C}}
{{omit from|Pascal}}
{{omit from|Processing}}
{{omit from|TI-83 BASIC}}
{{omit from|TI-89 BASIC}}
|