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.
imported>Maruseron (Added a Java (JDK 21 + Preview features) translation for the existing Kotlin solution. Removed the omission tag for Java.) |
|||
| (92 intermediate revisions by 41 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.
;Task:
As an example, implement insertion in a [[wp: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.
<br><br>
;Reference:
[https://www.cs.tufts.edu/comp/150FP/archive/chris-okasaki/redblack99.pdf Red-Black Trees in a Functional Setting]
=={{header|Bracmat}}==
<syntaxhighlight lang="bracmat">( ( balance
= a x b y c zd
. !arg
: ( B
. ( ( R
. ((R.?a,?x,?b),?y,?c)
| (?a,?x,(R.?b,?y,?c))
)
, ?zd
)
| ( ?a
, ?x
, ( R
. ((R.?b,?y,?c),?zd)
| (?b,?y,(R.?c,?zd))
)
)
)
& (R.(B.!a,!x,!b),!y,(B.!c,!zd))
| !arg
)
& ( ins
= C X tree a m z
. !arg:(?X.?tree)
& !tree:(?C.?a,?m,?z)
& ( !X:<!m
& balance$(!C.ins$(!X.!a),!m,!z)
| !X:>!m
& balance$(!C.!a,!m,ins$(!X.!z))
| !tree
)
| (R.,!X,)
)
& ( insert
= X tree
. !arg:(?X.?tree)
& ins$(!X.!tree):(?.?X)
& (B.!X)
)
& ( insertMany
= L R tree
. !arg:(%?L_%?R.?tree)
& insertMany$(!L.!tree):?tree
& insertMany$(!R.!tree)
| insert$!arg
)
);</syntaxhighlight>
Test:
<syntaxhighlight lang="bracmat">( ( it allows for terse code which is easy to read
, and can represent the algorithm directly
.
)
: ?values
& insertMany$(!values.):?tree
& lst$tree
& done
);</syntaxhighlight>
Output:
<syntaxhighlight lang="bracmat">(tree=
B
. ( B
. (R.(B.,,),algorithm,(B.,allows,))
, and
, (B.,can,)
)
, code
, ( R
. ( B
. (B.(R.,directly,),easy,)
, for
, (B.(R.,is,),it,)
)
, read
, ( B
. (B.,represent,)
, terse
, (R.(B.,the,),to,(B.,which,))
)
)
);</syntaxhighlight>
=={{header|C++}}==
{{trans|Haskell}}
===Compile time===
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.
<syntaxhighlight lang="cpp">enum Color { R, B };
template<Color, class, auto, class> struct T;
struct E;
template<Color col, class a, auto x, class b> struct balance {
using type = T<col, a, x, b>;
};
template<class a, auto x, class b, auto y, class c, auto z, class d>
struct balance<B, T<R, T<R, a, x, b>, y, c>, z, d> {
using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
};
template<class a, auto x, class b, auto y, class c, auto z, class d>
struct balance<B, T<R, a, x, T<R, b, y, c>>, z, d> {
using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
};
template<class a, auto x, class b, auto y, class c, auto z, class d>
struct balance<B, a, x, T<R, T<R, b, y, c>, z, d>> {
using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
};
template<class a, auto x, class b, auto y, class c, auto z, class d>
struct balance<B, a, x, T<R, b, y, T<R, c, z, d>>> {
using type = T<R, T<B, a, x, b>, y, T<B, c, z, d>>;
};
template<auto x, class s> struct insert {
template<class, class = void> struct ins;
template<class _> struct ins<E, _> { using type = T<R, E, x, E>; };
template<Color col, class a, auto y, class b> struct ins<T<col, a, y, b>> {
template<int, class = void> struct cond;
template<class _> struct cond<-1, _> : balance<col, typename ins<a>::type, y, b> {};
template<class _> struct cond<1, _> : balance<col, a, y, typename ins<b>::type> {};
template<class _> struct cond<0, _> { using type = T<col, a, y, b>; };
using type = typename cond<x < y ? -1 : y < x ? 1 : 0>::type;
};
template<class> struct repaint;
template<Color col, class a, auto y, class b>
struct repaint<T<col, a, y, b>> { using type = T<B, a, y, b>; };
using type = typename repaint<typename ins<s>::type>::type;
};
template<auto x, class s> using insert_t = typename insert<x, s>::type;
template<class> void print();
int main() {
print<insert_t<1, insert_t<2, insert_t<0, insert_t<4, E>>>>>();
}</syntaxhighlight>
===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.
<syntaxhighlight lang="cpp">#include <memory>
#include <variant>
template<class... Ts> struct overloaded : Ts... { using Ts::operator()...; };
template<class... Ts> overloaded(Ts...) -> overloaded<Ts...>;
enum Color { R, B };
using E = std::monostate;
template<class, Color> struct Node;
template<class T, Color C> using Ptr = std::unique_ptr<Node<T, C>>;
template<class T> using Tree = std::variant<E, Ptr<T, R>, Ptr<T, B>>;
template<class T, Color Col> struct Node {
static constexpr auto C = Col;
Tree<T> left;
T value;
Tree<T> right;
};
template<Color C, class A, class T, class B> Tree<T> tree(A&& a, T& x, B&& b) {
return Tree<T>{Ptr<T, C>{new Node<T, C>{std::move(a), std::move(x), std::move(b)}}};
}
template<class T> Tree<T> balance(Tree<T> s) {
auto&& ll = [](Ptr<T, R>& s, Ptr<T, R>& t, auto&, Ptr<T, B>& u, auto&, auto&, auto&) {
auto& [a, x, b] = *s;
auto& [s_, y, c] = *t;
auto& [t_, z, d] = *u;
return tree<R>(tree<B>(a, x, b), y, tree<B>(c, z, d));
};
auto&& lr = [](auto&, Ptr<T, R>& s, Ptr<T, R>& t, Ptr<T, B>& u, auto&, auto&, auto&) {
auto& [a, x, t_] = *s;
auto& [b, y, c] = *t;
auto& [s_, z, d] = *u;
return tree<R>(tree<B>(a, x, b), y, tree<B>(c, z, d));
};
auto&& rl = [](auto&, auto&, auto&, Ptr<T, B>& s, Ptr<T, R>& t, Ptr<T, R>& u, auto&) {
auto& [a, x, u_] = *s;
auto& [b, y, c] = *t;
auto& [t_, z, d] = *u;
return tree<R>(tree<B>(a, x, b), y, tree<B>(c, z, d));
};
auto&& rr = [](auto&, auto&, auto&, Ptr<T, B>& s, auto&, Ptr<T, R>& t, Ptr<T, R>& u) {
auto& [a, x, t_] = *s;
auto& [b, y, u_] = *t;
auto& [c, z, d] = *u;
return tree<R>(tree<B>(a, x, b), y, tree<B>(c, z, d));
};
auto&& l = [](auto& s) -> Tree<T>& {
return *std::visit(overloaded{[&](E) { return &s; }, [](auto& t) { return &t->left; }}, s);
};
auto&& r = [](auto& s) -> Tree<T>& {
return *std::visit(overloaded{[&](E) { return &s; }, [](auto& t) { return &t->right; }}, s);
};
return std::visit([&](auto&... ss) -> Tree<T> {
if constexpr (1 <
std::is_invocable_v<decltype(ll), decltype(ss)...> +
std::is_invocable_v<decltype(lr), decltype(ss)...> +
std::is_invocable_v<decltype(rl), decltype(ss)...> +
std::is_invocable_v<decltype(rr), decltype(ss)...>)
throw std::logic_error{""};
else
return overloaded{ll, lr, rl, rr, [&](auto&... ss) { return std::move(s); }}(ss...);
}, l(l(s)), l(s), r(l(s)), s, l(r(s)), r(s), r(r(s)));
}
template<class T> Tree<T> ins(T& x, Tree<T>& s) {
return std::visit(overloaded{
[&](E) -> Tree<T> { return tree<R>(s, x, s); },
[&](auto& t) {
auto& [a, y, b] = *t;
static constexpr auto Col = std::remove_reference_t<decltype(*t)>::C;
return x < y ? balance(tree<Col>(ins(x, a), y, b)) :
y < x ? balance(tree<Col>(a, y, ins(x, b))) :
std::move(s);
},
}, s);
}
template<class T> Tree<T> insert(T x, Tree<T> s) {
return std::visit(overloaded{
[](E) -> Tree<T> { throw std::logic_error{""}; },
[](auto&& t) {
auto& [a, y, b] = *t;
return tree<B>(a, y, b);
}
}, ins(x, s));
}
#include <iostream>
template<class T> void print(Tree<T> const& s, int i = 0) {
std::visit(overloaded{
[](E) {},
[&](auto& t) {
auto& [a, y, b] = *t;
print(a, i + 1);
std::cout << std::string(i, ' ') << "RB"[t->C] << " " << y << "\n";
print(b, i + 1);
}
}, s);
}
int main(int argc, char* argv[]) {
auto t = Tree<std::string>{};
for (auto i = 1; i != argc; ++i)
t = insert(std::string{argv[i]}, std::move(t));
print(t);
}</syntaxhighlight>
=={{header|C sharp}}==
Translation of several
{{works with|C sharp|8}}
<syntaxhighlight lang="csharp">using System;
class Tree
{
public static void Main() {
Tree tree = Tree.E;
for (int i = 1; i <= 16; i++) {
tree = tree.Insert(i);
}
tree.Print();
}
private const bool B = false, R = true;
public static readonly Tree E = new Tree(B, null, 0, null);
private Tree(bool c, Tree? l, int v, Tree? r) => (IsRed, Left, Value, Right) = (c, l ?? this, v, r ?? this);
public bool IsRed { get; private set; }
public int Value { get; }
public Tree Left { get; }
public Tree Right { get; }
public static implicit operator Tree((bool c, Tree l, int v, Tree r) t) => new Tree(t.c, t.l, t.v, t.r);
public void Deconstruct(out bool c, out Tree l, out int v, out Tree r) => (c, l, v, r) = (IsRed, Left, Value, Right);
public override string ToString() => this == E ? "[]" : $"[{(IsRed ? 'R' : 'B')}{Value}]";
public Tree Insert(int x) => Ins(x).MakeBlack();
private Tree MakeBlack() { IsRed = false; return this; }
public void Print(int indent = 0) {
if (this != E) Right.Print(indent + 1);
Console.WriteLine(new string(' ', indent * 4) + ToString());
if (this != E) Left.Print(indent + 1);
}
private Tree Ins(int x) => Math.Sign(x.CompareTo(Value)) switch {
_ when this == E => (R, E, x, E),
-1 => new Tree(IsRed, Left.Ins(x) , Value, Right).Balance(),
1 => new Tree(IsRed, Left , Value, Right.Ins(x)).Balance(),
_ => this
};
private Tree Balance() => this switch {
(B, (R, (R, var a, var x, var b), var y, var c), var z, var d) => (R, (B, a, x, b), y, (B, c, z, d)),
(B, (R, var a, var x, (R, var b, var y, var c)), var z, var d) => (R, (B, a, x, b), y, (B, c, z, d)),
(B, var a, var x, (R, (R, var b, var y, var c), var z, var d)) => (R, (B, a, x, b), y, (B, c, z, d)),
(B, var a, var x, (R, var b, var y, (R, var c, var z, var d))) => (R, (B, a, x, b), y, (B, c, z, d)),
_ => this
};
}</syntaxhighlight>
{{out}}
<pre>
[]
[R16]
[]
[B15]
[]
[B14]
[]
[B13]
[]
[B12]
[]
[B11]
[]
[B10]
[]
[B9]
[]
[B8]
[]
[B7]
[]
[B6]
[]
[B5]
[]
[B4]
[]
[B3]
[]
[B2]
[]
[B1]
[]</pre>
=={{header|Clojure}}==
Pattern matching library: [https://github.com/clojure/core.match core.match].
For code and a thorough write-up on the red-black tree implementation that uses core.match, please read: [https://github.com/clojure-cookbook/clojure-cookbook/blob/master/02_composite-data/2-27_and_2-28_custom-data-structures/2-27_red-black-trees-part-i.asciidoc Clojure Cookbook - Data Structures: Red-Black Trees].
=={{header|Common Lisp}}==
Line 13 ⟶ 356:
{{libheader|toadstool}}
<
(defstruct (red-black-tree (:constructor tree (color left val right)))
color left val right)
Line 51 ⟶ 394:
(defun insert (x s)
(toad-ecase1 (%insert x s)
((tree t a y b) (tree 'black a y b))))</
=={{
{{trans|Haskell}}
Line 96 ⟶ 439:
> }
> tree
=={{header|EchoLisp}}==
<syntaxhighlight lang="scheme">
;; code adapted from Racket and Common Lisp
;; Illustrates matching on structures
(require 'match)
(require 'struct)
(define (N-tostring n) (format "%s %d" (N-color n) (N-value n)))
(struct N (color left value right) #:tostring N-tostring)
(define (balance t)
(match t
[(N '⚫️ (N '🔴 (N '🔴 a x b) y c) z d) (N '🔴 (N '⚫️ a x b) y (N '⚫️ c z d))]
[(N '⚫️ (N '🔴 a x (N '🔴 b y c)) z d) (N '🔴 (N '⚫️ a x b) y (N '⚫️ c z d))]
[(N '⚫️ a x (N '🔴 (N '🔴 b y c) z d)) (N '🔴 (N '⚫️ a x b) y (N '⚫️ c z d))]
[(N '⚫️ a x (N '🔴 b y (N '🔴 c z d))) (N '🔴 (N '⚫️ a x b) y (N '⚫️ c z d))]
[else t]))
(define (ins value: x tree: t)
(match t
['empty (N '🔴 'empty x 'empty)]
[(N c l v r) (cond [(< x v) (balance (N c (ins x l) v r))]
[(> x v) (balance (N c l v (ins x r)))]
[else t])]))
(define (insert value: x tree: s)
(match (ins x s) [(N _ l v r) (N '⚫️ l v r)]))
</syntaxhighlight>
{{out}}
<syntaxhighlight lang="scheme">
(define (t-show n (depth 0))
(when (!eq? 'empty n)
(t-show (N-left n) (+ 12 depth))
(writeln (string-pad-left (format "%s" n ) depth))
(t-show (N-right n) (+ 12 depth))))
(define T (for/fold [t 'empty] ([i 32]) (insert (random 100) t)))
(t-show T)
</syntaxhighlight>
<small>
<pre>
🔴 1
⚫️ 2
⚫️ 7
⚫️ 8
🔴 11
🔴 17
⚫️ 25
⚫️ 28
⚫️ 31
⚫️ 32
⚫️ 36
⚫️ 40
⚫️ 43
⚫️ 44
🔴 45
⚫️ 53
⚫️ 71
🔴 72
⚫️ 73
⚫️ 83
⚫️ 89
🔴 91
⚫️ 92
🔴 94
⚫️ 99
</pre>
</small>
=={{header|Elixir}}==
{{trans|Erlang}}
But, it changed an API into the Elixir style.
<syntaxhighlight lang="elixir">defmodule RBtree do
def find(nil, _), do: :not_found
def find({ key, value, _, _, _ }, key), do: { :found, { key, value } }
def find({ key1, _, _, left, _ }, key) when key < key1, do: find(left, key)
def find({ key1, _, _, _, right }, key) when key > key1, do: find(right, key)
def new(key, value), do: ins(nil, key, value) |> make_black
def insert(tree, key, value), do: ins(tree, key, value) |> make_black
defp ins(nil, key, value),
do: { key, value, :r, nil, nil }
defp ins({ key, _, color, left, right }, key, value),
do: { key, value, color, left, right }
defp ins({ ky, vy, cy, ly, ry }, key, value) when key < ky,
do: balance({ ky, vy, cy, ins(ly, key, value), ry })
defp ins({ ky, vy, cy, ly, ry }, key, value) when key > ky,
do: balance({ ky, vy, cy, ly, ins(ry, key, value) })
defp make_black({ key, value, _, left, right }),
do: { key, value, :b, left, right }
defp balance({ kx, vx, :b, lx, { ky, vy, :r, ly, { kz, vz, :r, lz, rz } } }),
do: { ky, vy, :r, { kx, vx, :b, lx, ly }, { kz, vz, :b, lz, rz } }
defp balance({ kx, vx, :b, lx, { ky, vy, :r, { kz, vz, :r, lz, rz }, ry } }),
do: { kz, vz, :r, { kx, vx, :b, lx, lz }, { ky, vy, :b, rz, ry } }
defp balance({ kx, vx, :b, { ky, vy, :r, { kz, vz, :r, lz, rz }, ry }, rx }),
do: { ky, vy, :r, { kz, vz, :b, lz, rz }, { kx, vx, :b, ry, rx } }
defp balance({ kx, vx, :b, { ky, vy, :r, ly, { kz, vz, :r, lz, rz } }, rx }),
do: { kz, vz, :r, { ky, vy, :b, ly, lz }, { kx, vx, :b, rz, rx } }
defp balance(t),
do: t
end
RBtree.new(0,3) |> IO.inspect
|> RBtree.insert(1,5) |> IO.inspect
|> RBtree.insert(2,-1) |> IO.inspect
|> RBtree.insert(3,7) |> IO.inspect
|> RBtree.insert(4,-3) |> IO.inspect
|> RBtree.insert(5,0) |> IO.inspect
|> RBtree.insert(6,-1) |> IO.inspect
|> RBtree.insert(7,0) |> IO.inspect
|> RBtree.find(4) |> IO.inspect</syntaxhighlight>
{{out}}
<pre>
{0, 3, :b, nil, nil}
{0, 3, :b, nil, {1, 5, :r, nil, nil}}
{1, 5, :b, {0, 3, :b, nil, nil}, {2, -1, :b, nil, nil}}
{1, 5, :b, {0, 3, :b, nil, nil}, {2, -1, :b, nil, {3, 7, :r, nil, nil}}}
{1, 5, :b, {0, 3, :b, nil, nil},
{3, 7, :r, {2, -1, :b, nil, nil}, {4, -3, :b, nil, nil}}}
{1, 5, :b, {0, 3, :b, nil, nil},
{3, 7, :r, {2, -1, :b, nil, nil}, {4, -3, :b, nil, {5, 0, :r, nil, nil}}}}
{3, 7, :b, {1, 5, :b, {0, 3, :b, nil, nil}, {2, -1, :b, nil, nil}},
{5, 0, :b, {4, -3, :b, nil, nil}, {6, -1, :b, nil, nil}}}
{3, 7, :b, {1, 5, :b, {0, 3, :b, nil, nil}, {2, -1, :b, nil, nil}},
{5, 0, :b, {4, -3, :b, nil, nil}, {6, -1, :b, nil, {7, 0, :r, nil, nil}}}}
{:found, {4, -3}}
</pre>
=={{header|Emacs Lisp}}==
The <code>pcase</code> macro was added in Emacs 24.1. It's auto-loaded, so there's no need to add <code>(require 'pcase)</code> to your 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)))
(`(B (R ,a ,x (R ,b ,y ,c)) ,z ,d) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
(`(B ,a ,x (R (R ,b ,y ,c) ,z ,d)) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
(`(B ,a ,x (R ,b ,y (R ,c ,z ,d))) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
(_ tree)))
(defun rbt-insert- (x s)
(pcase s
(`nil `(R nil ,x nil))
(`(,color ,a ,y ,b) (cond ((< x y)
(rbt-balance `(,color ,(rbt-insert- x a) ,y ,b)))
((> x y)
(rbt-balance `(,color ,a ,y ,(rbt-insert- x b))))
(t
s)))
(_ (error "Expected tree: %S" s))))
(defun rbt-insert (x s)
(pcase (rbt-insert- x s)
(`(,_ ,a ,y ,b) `(B ,a ,y ,b))
(_ (error "Internal error: %S" s))))
(let ((s nil))
(dotimes (i 16)
(setq s (rbt-insert (1+ i) s)))
(pp s))</syntaxhighlight>
Output:
<pre>
(B
(B
(B
(B nil 1 nil)
2
(B nil 3 nil))
4
(B
(B nil 5 nil)
6
(B nil 7 nil)))
8
(B
(B
(B nil 9 nil)
10
(B nil 11 nil))
12
(B
(B nil 13 nil)
14
(B nil 15
(R nil 16 nil)))))
</pre>
=={{header|Erlang}}==
The code used here is extracted from [https://gist.github.com/mjn/2648040 Mark Northcott's GitHubGist].
<syntaxhighlight lang="erlang">
-module(rbtree).
-export([insert/3, find/2]).
% Node structure: { Key, Value, Color, Smaller, Bigger }
find(_, nil) ->
not_found;
find(Key, { Key, Value, _, _, _ }) ->
{ found, { Key, Value } };
find(Key, { Key1, _, _, Left, _ }) when Key < Key1 ->
find(Key, Left);
find(Key, { Key1, _, _, _, Right }) when Key > Key1 ->
find(Key, Right).
insert(Key, Value, Tree) ->
make_black(ins(Key, Value, Tree)).
ins(Key, Value, nil) ->
{ Key, Value, r, nil, nil };
ins(Key, Value, { Key, _, Color, Left, Right }) ->
{ Key, Value, Color, Left, Right };
ins(Key, Value, { Ky, Vy, Cy, Ly, Ry }) when Key < Ky ->
balance({ Ky, Vy, Cy, ins(Key, Value, Ly), Ry });
ins(Key, Value, { Ky, Vy, Cy, Ly, Ry }) when Key > Ky ->
balance({ Ky, Vy, Cy, Ly, ins(Key, Value, Ry) }).
make_black({ Key, Value, _, Left, Right }) ->
{ Key, Value, b, Left, Right }.
balance({ Kx, Vx, b, Lx, { Ky, Vy, r, Ly, { Kz, Vz, r, Lz, Rz } } }) ->
{ Ky, Vy, r, { Kx, Vx, b, Lx, Ly }, { Kz, Vz, b, Lz, Rz } };
balance({ Kx, Vx, b, Lx, { Ky, Vy, r, { Kz, Vz, r, Lz, Rz }, Ry } }) ->
{ Kz, Vz, r, { Kx, Vx, b, Lx, Lz }, { Ky, Vy, b, Rz, Ry } };
balance({ Kx, Vx, b, { Ky, Vy, r, { Kz, Vz, r, Lz, Rz }, Ry }, Rx }) ->
{ Ky, Vy, r, { Kz, Vz, b, Lz, Rz }, { Kx, Vx, b, Ry, Rx } };
balance({ Kx, Vx, b, { Ky, Vy, r, Ly, { Kz, Vz, r, Lz, Rz } }, Rx }) ->
{ Kz, Vz, r, { Ky, Vy, b, Ly, Lz }, { Kx, Vx, b, Rz, Rx } };
balance(T) ->
T.
</syntaxhighlight>
Output:
<pre>
> rbtree:insert(0,3,nil).
{0,3,b,nil,nil}
> T1 = rbtree:insert(0,3,nil).
{0,3,b,nil,nil}
> T2 = rbtree:insert(1,5,T1).
{0,3,b,nil,{1,5,r,nil,nil}}
> T3 = rbtree:insert(2,-1,T2).
{1,5,b,{0,3,b,nil,nil},{2,-1,b,nil,nil}}
> T4 = rbtree:insert(3,7,T3).
{1,5,b,{0,3,b,nil,nil},{2,-1,b,nil,{3,7,r,nil,nil}}}
> T5 = rbtree:insert(4,-3,T4).
{1,5,b,
{0,3,b,nil,nil},
{3,7,r,{2,-1,b,nil,nil},{4,-3,b,nil,nil}}}
> T6 = rbtree:insert(5,0,T5).
{1,5,b,
{0,3,b,nil,nil},
{3,7,r,{2,-1,b,nil,nil},{4,-3,b,nil,{5,0,r,nil,nil}}}}
> T7 = rbtree:insert(6,-1,T6).
{3,7,b,
{1,5,b,{0,3,b,nil,nil},{2,-1,b,nil,nil}},
{5,0,b,{4,-3,b,nil,nil},{6,-1,b,nil,nil}}}
> T8 = rbtree:insert(7,0,T7).
{3,7,b,
{1,5,b,{0,3,b,nil,nil},{2,-1,b,nil,nil}},
{5,0,b,{4,-3,b,nil,nil},{6,-1,b,nil,{7,0,r,nil,nil}}}}
> rbtree:find(4,T8).
{found,{4,-3}}
</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}}
<br>
Go doesn't have algebraic data types as such though they can simulated (to a limited extent) by interfaces.
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.
<syntaxhighlight lang="go">package main
import "fmt"
type Color string
const (
R Color = "R"
B = "B"
)
type Tree interface {
ins(x int) Tree
}
type E struct{}
func (_ E) ins(x int) Tree {
return T{R, E{}, x, E{}}
}
func (_ E) String() string {
return "E"
}
type T struct {
cl Color
le Tree
aa int
ri Tree
}
func (t T) balance() Tree {
if t.cl != B {
return t
}
le, leIsT := t.le.(T)
ri, riIsT := t.ri.(T)
var lele, leri, rile, riri T
var leleIsT, leriIsT, rileIsT, ririIsT bool
if leIsT {
lele, leleIsT = le.le.(T)
}
if leIsT {
leri, leriIsT = le.ri.(T)
}
if riIsT {
rile, rileIsT = ri.le.(T)
}
if riIsT {
riri, ririIsT = ri.ri.(T)
}
switch {
case leIsT && leleIsT && le.cl == R && lele.cl == R:
_, t2, z, d := t.destruct()
_, t3, y, c := t2.(T).destruct()
_, a, x, b := t3.(T).destruct()
return T{R, T{B, a, x, b}, y, T{B, c, z, d}}
case leIsT && leriIsT && le.cl == R && leri.cl == R:
_, t2, z, d := t.destruct()
_, a, x, t3 := t2.(T).destruct()
_, b, y, c := t3.(T).destruct()
return T{R, T{B, a, x, b}, y, T{B, c, z, d}}
case riIsT && rileIsT && ri.cl == R && rile.cl == R:
_, a, x, t2 := t.destruct()
_, t3, z, d := t2.(T).destruct()
_, b, y, c := t3.(T).destruct()
return T{R, T{B, a, x, b}, y, T{B, c, z, d}}
case riIsT && ririIsT && ri.cl == R && riri.cl == R:
_, a, x, t2 := t.destruct()
_, b, y, t3 := t2.(T).destruct()
_, c, z, d := t3.(T).destruct()
return T{R, T{B, a, x, b}, y, T{B, c, z, d}}
default:
return t
}
}
func (t T) ins(x int) Tree {
switch {
case x < t.aa:
return T{t.cl, t.le.ins(x), t.aa, t.ri}.balance()
case x > t.aa:
return T{t.cl, t.le, t.aa, t.ri.ins(x)}.balance()
default:
return t
}
}
func (t T) destruct() (Color, Tree, int, Tree) {
return t.cl, t.le, t.aa, t.ri
}
func (t T) String() string {
return fmt.Sprintf("T(%s, %v, %d, %v)", t.cl, t.le, t.aa, t.ri)
}
func insert(tr Tree, x int) Tree {
t := tr.ins(x)
switch t.(type) {
case T:
tt := t.(T)
_, a, y, b := tt.destruct()
return T{B, a, y, b}
case E:
return E{}
default:
return nil
}
}
func main() {
var tr Tree = E{}
for i := 1; i <= 16; i++ {
tr = insert(tr, i)
}
fmt.Println(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>
=={{header|Haskell}}==
<
data Tree a = E | T Color (Tree a) a (Tree a)
Line 116 ⟶ 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 represents a best effort translation of the current Haskell implementation of this task:
<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() {
if (color == Color.R) return this;
return switch (this) {
// unnamed patterns (case T<A>(_, ...)) are a JDK21 Preview feature
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.
<syntaxhighlight lang="julia">import Base.length
abstract type AbstractColoredNode end
struct RedNode <: AbstractColoredNode end; const R = RedNode()
struct BlackNode <: AbstractColoredNode end; const B = BlackNode()
struct Empty end; const E = Empty()
length(e::Empty) = 1
function balance(b::BlackNode, v::Vector, z, d)
if v[1] == R
if length(v[2]) == 4 && v[2][1] == R
return [R, [B, v[2][2], v[2][3], v[2][4]], v[3], [B, v[4], z, d]]
elseif length(v[4]) == 4 && v[4][1] == R
return [R, [B, v[2], v[3], v[4][2]], v[4][3], [B, v[4][4], z, d]]
end
end
[b, v, z, d]
end
function balance(b::BlackNode, a, x, v::Vector)
if v[1] == R
if length(v[2]) == 4 && v[2][1] == R
return [R, [B, a, x, v[2][2]], v[2][3], [B, v[2][4], v[3], v[4]]]
elseif length(v[4]) == 4 && v[4][1] == R
return [R, [B, a, x, v[2]], v[3], [B, v[4][2], v[4][3], v[4][4]]]
end
end
[b, a, x, v]
end
function balance(b::BlackNode, a::Vector, x, v::Vector)
if v[1] == R
if length(v[2]) == 4 && v[2][1] == R
return [R, [B, a, x, v[2][2]], v[2][3], [B, v[2][4], v[3], v[4]]]
elseif length(v[4]) == 4 && v[4][1] == R
return [R, [B, a, x, v[2]], v[3], [B, v[4][2], v[4][3], v[4][4]]]
end
end
[b, a, x, v]
end
balance(node, l, a, r) = [node, l, a, r]
function ins(v::Vector, x::Number)
if length(v) == 4
if x < v[3]
return balance(v[1], ins(v[2], x), v[3], v[4])
elseif x > v[3]
return balance(v[1], v[2], v[3], ins(v[4], x))
end
end
v
end
ins(t, a) = [R, E, a, E]
insert(v, a) = (t = ins(v, a); t[1] = B; t)
function testRB()
t = E
for i in rand(collect(1:20), 10)
t = insert(t, i)
end
println(replace(string(t), r"lackNode\(\)|edNode\(\)|Any|mpty\(\)" => ""))
end
testRB()
</syntaxhighlight>{{out}}
<pre>
[B, [R, [B, [R, E, 1, E], 2, [R, E, 3, E]], 4, [B, E, 6, E]], 14, [B, E, 18, E]]]
</pre>
=={{header|Kotlin}}==
{{trans|Scala}}
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!
<syntaxhighlight lang="scala">// version 1.1.51
import Color.*
enum class Color { R, B }
sealed class Tree<A : Comparable<A>> {
fun insert(x: A): Tree<A> {
val t = ins(x)
return when (t) {
is T -> {
val (_, a, y, b) = t
T(B, a, y, b)
}
is E -> E()
}
}
abstract fun ins(x: A): Tree<A>
}
class E<A : Comparable<A>> : Tree<A>() {
override fun ins(x: A): Tree<A> = T(R, E(), x, E())
override fun toString() = "E"
}
data class T<A : Comparable<A>>(
val cl: Color,
val le: Tree<A>,
val aa: A,
val ri: Tree<A>
) : Tree<A>() {
private fun balance(): Tree<A> {
if (cl != B) return this
val res =
if (le is T && le.le is T && le.cl == R && le.le.cl == R) {
val (_, t, z, d) = this
val (_, t2, y, c) = t as T
val (_, a, x, b) = t2 as T
T(R, T(B, a, x, b), y, T(B, c, z, d))
}
else if (le is T && le.ri is T && le.cl == R && le.ri.cl == R) {
val (_, t, z, d) = this
val (_, a, x, t2) = t as T
val (_, b, y, c) = t2 as T
T(R, T(B, a, x, b), y, T(B, c, z, d))
}
else if (ri is T && ri.le is T && ri.cl == R && ri.le.cl == R) {
val (_, a, x, t) = this
val (_, t2, z, d) = t as T
val (_, b, y, c) = t2 as T
T(R, T(B, a, x, b), y, T(B, c, z, d))
}
else if (ri is T && ri.ri is T && ri.cl == R && ri.ri.cl == R) {
val (_, a, x, t) = this
val (_, b, y, t2) = t as T
val (_, c, z, d) = t2 as T
T(R, T(B, a, x, b), y, T(B, c, z, d))
}
else this
return res
}
override fun ins(x: A): Tree<A> = when (x.compareTo(aa)) {
-1 -> T(cl, le.ins(x), aa, ri).balance()
+1 -> T(cl, le, aa, ri.ins(x)).balance()
else -> this
}
override fun toString() = "T($cl, $le, $aa, $ri)"
}
fun main(args: Array<String>) {
var tree: Tree<Int> = E()
for (i in 1..16) {
tree = tree.insert(i)
}
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|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 144 ⟶ 1,426:
in let T (_,a,y,b) = ins s
in T (B,a,y,b)
</syntaxhighlight>
=={{header|Oz}}==
Line 153 ⟶ 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 176 ⟶ 1,457:
in
t(b A Y B)
end</
=={{header|Perl}}==
{{works with|Perl|5.010}}
Although Perl does not have algebraic data types, it does have a wonderfully flexible regular expression engine, which is powerfully enough to perform the task.
However, representing a tree as a string, and repeatedly parsing that string, is truly inefficient way to solve the problem. Someday, someone will write a perl multi-method-dispatch module which is as amazing as Raku's, and then we can copy the Raku solution here.
The $balanced variable matches against either some data, or the empty tree (_), or, using perl's amazing recursive regular expression feature, a non-empty tree.
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.
<syntaxhighlight lang="perl">#!perl
use 5.010;
use strict;
use warnings qw(FATAL all);
my $balanced = qr{([^<>,]++|<(?-1),(?-1),(?-1),(?-1)>)};
my ($a, $b, $c, $d, $x, $y, $z) = map +qr((?<$_>$balanced)),
'a'..'d', 'x'..'z';
my $col = qr{(?<col>[RB])};
sub balance {
local $_ = shift;
if( /^<B,<R,<R,$a,$x,$b>,$y,$c>,$z,$d>\z/ or
/^<B,<R,$a,$x,<R,$b,$y,$c>>,$z,$d>\z/ or
/^<B,$a,$x,<R,<R,$b,$y,$c>,$z,$d>>\z/ or
/^<B,$a,$x,<R,$b,$y,<R,$c,$z,$d>>>\z/ )
{
my ($aa, $bb, $cc, $dd) = @+{'a'..'d'};
my ($xx, $yy, $zz) = @+{'x'..'z'};
"<R,<B,$aa,$xx,$bb>,$yy,<B,$cc,$zz,$dd>>";
} else {
$_;
}
}
sub
if($tree =~
my ($color, $aa, $bb, $yy) = @+{qw(col a b y)};
if( $xx < $yy ) {
return balance "<$color,".ins($xx,$aa).",$yy,$bb>";
} elsif( $xx > $yy ) {
return balance "<$color,$aa,$yy,".ins($xx,$bb).">";
} else {
return $tree;
}
} elsif( $tree !~ /,/) {
return "<R,_,$xx,_>";
} else {
print "Unexpected failure!\n";
print "Tree parts are: \n";
print $_, "\n" for $tree =~ /$balanced/g;
exit;
}
}
sub insert {
my $tree = ins(@_);
$tree =~ m{^<$col,$a,$y,$b>\z} or die;
"<B,$+{a},$+{y},$+{b}>";
}
MAIN: {
my @a = 1..10;
for my $aa ( 1 .. $#a ) {
my $bb = int rand( 1 + $aa );
@a[$aa, $bb] = @a[$bb, $aa];
}
my $t = "!";
for( @a ) {
$t = insert( $_, $t );
print "Tree: $t.\n";
}
}
print "Done\n";
</syntaxhighlight>
{{out}}
<pre>Tree: <B,_,9,_>.
Tree: <B,<R,_,7,_>,9,_>.
Tree: <B,<B,_,2,_>,7,<B,_,9,_>>.
Tree: <B,<B,_,2,<R,_,6,_>>,7,<B,_,9,_>>.
Tree: <B,<B,_,2,<R,_,6,_>>,7,<B,_,9,<R,_,10,_>>>.
Tree: <B,<R,<B,_,2,_>,5,<B,_,6,_>>,7,<B,_,9,<R,_,10,_>>>.
Tree: <B,<R,<B,_,2,<R,_,4,_>>,5,<B,_,6,_>>,7,<B,_,9,<R,_,10,_>>>.
Tree: <B,<R,<B,_,2,<R,_,4,_>>,5,<B,_,6,_>>,7,<B,<R,_,8,_>,9,<R,_,10,_>>>.
Tree: <B,<R,<B,<R,_,1,_>,2,<R,_,4,_>>,5,<B,_,6,_>>,7,<B,<R,_,8,_>,9,<R,_,10,_>>>.
Tree: <B,<B,<B,<R,_,1,_>,2,_>,3,<B,_,4,_>>,5,<B,<B,_,6,_>,7,<B,<R,_,8,_>,9,<R,_,10,_>>>>.
Done</pre>
=={{header|Phix}}==
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;">--
-- demo\rosetta\Pattern_matching.exw
-- =================================
--
-- 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;">else</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;">else</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>
┌R1
┌B2
┌B3
│└B4
─B5
│┌B6
││└R7
└B8
└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 248 ⟶ 1,776:
(be ins (@X E (T R E @X E)))
(be ins (@X (T @C @A @Y @B) @R)
(^ @
(ins @X @A @Ao)
(balance @C @Ao @Y @B @R)
T )
(be ins (@X (T @C @A @Y @B) @R)
(^ @ (> (-> @X) (-> @Y)))
(ins @X @B @Bo)
(balance @C @A @Y @Bo @R)
Line 260 ⟶ 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 288 ⟶ 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 293 ⟶ 1,955:
{{trans|OCaml}}
<syntaxhighlight lang
#lang racket
;; Using short names to make the code line up nicely
(struct N (color left value right) #:prefab)
(define (balance t)
(match t
[(
[(N 'B (N 'R a x (N 'R b y c)) z d) (
[(
[(N 'B a x (N 'R b y (N 'R c z d))) (
[else t]))
Line 312 ⟶ 1,972:
(define (ins t)
(match t
['empty (
[(
(match (ins s) [(N _ l v r) (N 'B l
(define (visualize t0)
(let loop ([t t0] [last? #t] [indent '()])
(for-each display (reverse indent))
(printf "~a~a[~a]\n" (I "\\-" "+-") (N-value t) (N-color t))
(define subs (filter N? (list (N-left t) (N-right t))))
(for ([s subs] [n (in-range (sub1 (length subs)) -1 -1)])
(loop s (zero? n) (cons (I " " "| ") indent)))))
(visualize (for/fold ([t 'empty]) ([i 16]) (insert i t)))
</syntaxhighlight>
<pre>
7[B]
+-3[B]
| +-1[B]
| | +-0[B]
| | \-2[B]
| \-5[B]
| +-4[B]
| \-6[B]
\-11[B]
+-9[B]
| +-8[B]
| \-10[B]
\-13[B]
+-12[B]
\-14[B]
\-15[R]
</pre>
=={{header|Raku}}==
(formerly Perl 6)
{{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" line>enum RedBlack <R B>;
multi balance(B,[R,[R,$a,$x,$b],$y,$c],$z,$d) { [R,[B,$a,$x,$b],$y,[B,$c,$z,$d]] }
multi balance(B,[R,$a,$x,[R,$b,$y,$c]],$z,$d) { [R,[B,$a,$x,$b],$y,[B,$c,$z,$d]] }
multi balance(B,$a,$x,[R,[R,$b,$y,$c],$z,$d]) { [R,[B,$a,$x,$b],$y,[B,$c,$z,$d]] }
multi balance(B,$a,$x,[R,$b,$y,[R,$c,$z,$d]]) { [R,[B,$a,$x,$b],$y,[B,$c,$z,$d]] }
multi balance($col, $a, $x, $b) { [$col, $a, $x, $b] }
multi ins( $x, @s [$col, $a, $y, $b] ) {
when $x before $y { balance $col, ins($x, $a), $y, $b }
when $x after $y { balance $col, $a, $y, ins($x, $b) }
default { @s }
}
multi ins( $x, Any:U ) { [R, Any, $x, Any] }
multi insert( $x, $s ) {
[B, |ins($x,$s)[1..3]];
}
sub MAIN {
my $t = Any;
$t = insert($_, $t) for (1..10).pick(*);
say $t.gist;
}</syntaxhighlight>
This code uses generic comparison operators <tt>before</tt> and <tt>after</tt>, so it should work on any ordered type.
{{out}}
<pre>[B [B [B (Any) 1 [R (Any) 2 (Any)]] 3 [B (Any) 4 [R (Any) 5 (Any)]]] 6 [B [B (Any) 7 (Any)] 8 [B [R (Any) 9 (Any)] 10 (Any)]]]</pre>
=={{header|Rascal}}==
Rascal offers many options for pattern matching. In essence, there are four sorts of patterns: Abstract, Concrete, PatternWithAction and classic Regular Expressions. These patterns can be used in several cases, for example switch or visit statements, on the right of the Match operator (:=), or in TryCatch statements for thrown exceptions. Each pattern binds variables in a conditional scope.
===Abstract===
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:
<syntaxhighlight lang="rascal">
// Literal
rascal>123 := 123
bool: true
// VariableDeclaration
rascal>if(str S := "abc")
>>>>>>> println("Match succeeds, S == \"<S>\"");
Match succeeds, S == "abc"
ok
// MultiVariable
rascal>if([10, N*, 50] := [10, 20, 30, 40, 50])
>>>>>>> println("Match succeeds, N == <N>");
Match succeeds, N == [20,30,40]
ok
// Variable
rascal>N = 10;
int: 10
rascal>N := 10;
bool: true
rascal>N := 20;
bool: false
// Set and List
rascal>if({10, set[int] S, 50} := {50, 40, 30, 20, 10})
>>>>>>> println("Match succeeded, S = <S>");
Match succeeded, S = {30,40,20}
ok
rascal>for([L1*, L2*] := [10, 20, 30, 40, 50])
>>>>>>> println("<L1> and <L2>");
[] and [10,20,30,40,50]
[10] and [20,30,40,50]
[10,20] and [30,40,50]
[10,20,30] and [40,50]
[10,20,30,40] and [50]
[10,20,30,40,50] and []
list[void]: []
// Descendant
rascal>T = red(red(black(leaf(1), leaf(2)), black(leaf(3), leaf(4))), black(leaf(5), leaf(4)));
rascal>for(/black(_,leaf(4)) := T)
>>>>>>> println("Match!");
Match!
Match!
list[void]: []
rascal>for(/black(_,leaf(int N)) := T)
>>>>>>> println("Match <N>");
Match 2
Match 4
Match 4
list[void]: []
rascal>for(/int N := T)
>>>>>>> append N;
list[int]: [1,2,3,4,5,4]
// Labelled
rascal>for(/M:black(_,leaf(4)) := T)
>>>>>>> println("Match <M>");
Match black(leaf(3),leaf(4))
Match black(leaf(5),leaf(4))
list[void]: []</syntaxhighlight>
===Concrete===
Suppose we want to manipulate text written in some hypothetical language LANG. Then first the concrete syntax of LANG has to be defined by importing a module that declares the non-terminals and syntax rules for LANG. Next LANG programs have to be parsed. LANG programs made come from text files or they may be included in the Rascal program as literals. In both cases the text is parsed according to the defined syntax and the result is a parse tree in the form of a value of type Tree. Concrete patterns operate on these trees.
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:
<syntaxhighlight lang="rascal">// Quoted pattern
` Token1 Token2 ... Tokenn `
// A typed quoted pattern
(Symbol) ` Token1 Token2 ... TokenN `
// A typed variable pattern
<Type Var>
// A variable pattern
<Var></syntaxhighlight>
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].
===PatternWithAction===
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:
<syntaxhighlight lang="rascal">// Define ColoredTrees with red and black nodes and integer leaves
data ColoredTree = leaf(int N)
| red(ColoredTree left, ColoredTree right)
| black(ColoredTree left, ColoredTree right);
// Count the number of black nodes
public int cntBlack(ColoredTree t){
int c = 0;
visit(t) {
case black(_,_): c += 1;
};
return c;
}
// Returns if a tree is balanced
public bool balance(ColoredTree t){
visit(t){
case black(a,b): if (cntBlack(a) == cntBlack(b)) true; else return false;
case red(a,b): if (cntBlack(a) == cntBlack(b)) true; else return false;
}
return true;
}
// Compute the sum of all integer leaves
public int addLeaves(ColoredTree t){
int c = 0;
visit(t) {
case leaf(int N): c += N;
};
return c;
}
// Add green nodes to ColoredTree
data ColoredTree = green(ColoredTree left, ColoredTree right);
// Transform red nodes into green nodes
public ColoredTree makeGreen(ColoredTree t){
return visit(t) {
case red(l, r) => green(l, r)
};
}</syntaxhighlight>
===Regular Expressions===
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.
<syntaxhighlight lang="rascal">rascal>/XX/i := "some xx";
bool: true
rascal>/a.c/ := "abc";
bool: true</syntaxhighlight>
=={{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]]
<syntaxhighlight lang="rexx">/*REXX pgm builds a red/black tree (with verification & validation), balanced as needed.*/
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. */
if insert='' then insert= 22.44 44.66 /* " inserts.*/
top= . /*define the default for the TOP var.*/
call Dnodes nodes /*define nodes, balance them as added. */
call Dnodes insert /*insert " " " " needed.*/
call Lnodes /*list the nodes (with indentations). */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
err: say; say '***error***: ' arg(1); say; exit 13
/*──────────────────────────────────────────────────────────────────────────────────────*/
Dnodes: arg $d; do j=1 for words($d); t= word($d, j) /*color: encoded into L. */
parse var t p '.' a "." b '.' x 1 . . . xx
call Vnodes p a b
if x\=='' then call err "too many nodes specified: " xx
if p\==top then if @.p==. then call err "node isn't defined: " p
if p ==top then do; !.p=1; L.1=p; end /*assign the top node. */
@.p= a b; n= !.p + 1 /*assign node; bump level.*/
if a\=='' then do; !.a= n; @.a=; maxL= max(maxL, !.a); end
if b\=='' then do; !.b= n; @.b=; maxL= max(maxL, !.b); end
L.n= space(L.n a b) /*append to the level list*/
end /*j*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
Lnodes: do L=1 for maxL; w= length(maxL); rb= word('(red) (black)', 1+L//2)
say "level:" right(L, w) left('', L+L) " ───► " rb ' ' L.L
end /*lev*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
Vnodes: arg $v; do v=1 for words($v); y= word($v, v)
if \datatype(y, 'W') then call err "node isn't a whole number: " y
y= y / 1 /*normalize Y int.: no LZ, dot*/
if top==. then do; LO=y; top=y; HI=y; L.=; @.=; maxL=1; end
LO= min(LO, y); HI= max(HI, y)
if @.y\==. & @.y\=='' then call err "node is already defined: " y
end /*v*/
return</syntaxhighlight>
{{out|output|text= when using the default inputs:}}
<pre>
level: 1 ───► (black) 13
level: 2 ───► (red) 8 17
level: 3 ───► (black) 1 11 15 25
level: 4 ───► (red) 6 22 27
level: 5 ───► (black) 44
level: 6 ───► (red) 66
</pre>
=={{header|Rust}}==
{{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.
<syntaxhighlight lang="rust">#![feature(box_patterns, box_syntax)]
use self::Color::*;
use std::cmp::Ordering::*;
enum Color {R,B}
type Link<T> = Option<Box<N<T>>>;
struct N<T> {
c: Color,
l: Link<T>,
val: T,
r: Link<T>,
}
impl<T: Ord> N<T> {
fn balance(col: Color, n1: Link<T>, z: T, n2: Link<T>) -> Link<T> {
Some(box
match (col,n1,n2) {
(B, Some(box N {c: R, l: Some(box N {c: R, l: a, val: x, r: b}), val: y, r: c}), d)
| (B, Some(box N {c: R, l: a, val: x, r: Some (box N {c: R, l: b, val: y, r: c})}), d)
=> N {c: R, l: Some(box N {c: B, l: a, val: x, r: b}), val: y, r: Some(box N {c: B, l: c, val: z, r: d})},
(B, a, Some(box N {c: R, l: Some(box N {c: R, l: b, val: y, r: c}), val: v, r: d}))
| (B, a, Some(box N {c: R, l: b, val: y, r: Some(box N {c: R, l: c, val: v, r: d})}))
=> N {c: R, l: Some(box N {c: B, l: a, val: z, r: b}), val: y, r: Some(box N {c: B, l: c, val: v, r: d})},
(col, a, b) => N {c: col, l: a, val: z, r: b},
})
}
fn insert(x: T, n: Link<T>) -> Link<T> {
match n {
None => Some(box N { c: R, l: None, val: x, r: None }),
Some(n) => {
let n = *n;
let N {c: col, l: a, val: y, r: b} = n;
match x.cmp(&y) {
Greater => Self::balance(col, a,y,Self::insert(x,b)),
Less => Self::balance(col, Self::insert(x,a),y,b),
Equal => Some(box N {c: col, l: a, val: y, r: b})
}
}
}
}
}</syntaxhighlight>
=={{header|Scala}}==
Line 355 ⟶ 2,317:
of that object.
<
sealed abstract class Color
case object R extends Color
Line 387 ⟶ 2,349:
}
}
}</
Usage example:
Line 404 ⟶ 2,366:
=={{header|Standard ML}}==
<
datatype color = R | B
datatype 'a tree = E | T of color * 'a tree * 'a * 'a tree
Line 429 ⟶ 2,391:
T (B,a,y,b)
end
</syntaxhighlight>
=={{header|Swift}}==
{{works with|Swift|2+}}
<syntaxhighlight lang="swift">enum Color { case R, B }
enum Tree<A> {
case E
indirect case T(Color, Tree<A>, A, Tree<A>)
}
func balance<A>(input: (Color, Tree<A>, A, Tree<A>)) -> Tree<A> {
switch input {
case let (.B, .T(.R, .T(.R,a,x,b), y, c), z, d): return .T(.R, .T(.B,a,x,b), y, .T(.B,c,z,d))
case let (.B, .T(.R, a, x, .T(.R,b,y,c)), z, d): return .T(.R, .T(.B,a,x,b), y, .T(.B,c,z,d))
case let (.B, a, x, .T(.R, .T(.R,b,y,c), z, d)): return .T(.R, .T(.B,a,x,b), y, .T(.B,c,z,d))
case let (.B, a, x, .T(.R, b, y, .T(.R,c,z,d))): return .T(.R, .T(.B,a,x,b), y, .T(.B,c,z,d))
case let (col, a, x, b) : return .T(col, a, x, b)
}
}
func insert<A : Comparable>(x: A, s: Tree<A>) -> Tree<A> {
func ins(s: Tree<A>) -> Tree<A> {
switch s {
case .E : return .T(.R,.E,x,.E)
case let .T(col,a,y,b):
if x < y {
return balance((col, ins(a), y, b))
} else if x > y {
return balance((col, a, y, ins(b)))
} else {
return s
}
}
}
switch ins(s) {
case let .T(_,a,y,b): return .T(.B,a,y,b)
case .E:
assert(false)
return .E
}
}</syntaxhighlight>
=={{header|Tailspin}}==
{{trans|Haskell}}
Tailspin doesn't have type names, so here using a tag. Neither does it have destructuring (which seems to be posited in the problem statement). Arguably, pattern matching in Tailspin is more readable while still as concise.
<syntaxhighlight lang="tailspin">
processor RedBlackTree
data node <{VOID}|{colour: <='black'|='red'>, left: <node>, right: <node>, value: <> VOID}> local
@: {};
sink insert
templates balance
when <{colour: <='black'>, left: <{ colour: <='red'> left: <{colour: <='red'>}>}>}>
do { colour: 'red',
left: { $.left.left..., colour: 'black'},
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},
value: $.left.right.value,
right: { $..., left: $.left.right.right }} !
when <{colour: <='black'>, right: <{ colour: <='red'> left: <{colour: <='red'>}>}>}>
do { colour: 'red',
left: { $..., right: $.right.left.left},
value: $.right.left.value,
right: { $.right..., colour: 'black', left: $.right.left.right }} !
when <{colour: <='black'>, right: <{ colour: <='red'> right: <{colour: <='red'>}>}>}>
do { colour: 'red',
left: { $..., right: $.right.left},
value: $.right.value,
right: { $.right.right..., colour: 'black' }} !
otherwise $ !
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
@RedBlackTree: { $ -> ins&{into: $@RedBlackTree} ..., colour: 'black'};
end insert
source toString
'$@RedBlackTree;' !
end toString
end RedBlackTree
def tree: $RedBlackTree;
1..5 -> \('$tree::toString;$#10;' -> !OUT::write $ -> !tree::insert \) -> !VOID
$tree::toString -> !OUT::write
</syntaxhighlight>
{{out}}
<pre>
{}
{colour=black, left={}, right={}, value=1}
{colour=black, left={}, right={colour=red, left={}, right={}, value=2}, value=1}
{colour=black, left={colour=black, left={}, right={}, value=1}, right={colour=black, left={}, right={}, value=3}, value=2}
{colour=black, left={colour=black, left={}, right={}, value=1}, right={colour=black, left={}, right={colour=red, left={}, right={}, value=4}, value=3}, value=2}
{colour=black, left={colour=black, left={}, right={}, value=1}, right={colour=red, left={colour=black, left={}, right={}, value=3}, right={colour=black, left={}, right={}, value=5}, value=4}, value=2}
</pre>
=={{header|Tcl}}==
Line 435 ⟶ 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 505 ⟶ 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 537 ⟶ 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|TI-83 BASIC}}
{{omit from|TI-89 BASIC}}
| |||