Algebraic data types: Difference between revisions

Added a Java (JDK 21 + Preview features) translation for the existing Kotlin solution. Removed the omission tag for Java.
(Added C#)
imported>Maruseron
(Added a Java (JDK 21 + Preview features) translation for the existing Kotlin solution. Removed the omission tag for Java.)
 
(37 intermediate revisions by 17 users not shown)
Line 1:
{{task|DataAlgebraic Structuresdata types}}
 
Some languages offer direct support for [[wp:Algebraic_data_type|algebraic data types]] and pattern matching on them. While this of course can always be simulated with manual tagging and conditionals, it allows for terse code which is easy to read, and can represent the algorithm directly.
Line 10:
<br><br>
 
;Reference:
[https://www.cs.tufts.edu/comp/150FP/archive/chris-okasaki/redblack99.pdf Red-Black Trees in a Functional Setting]
=={{header|Bracmat}}==
 
<langsyntaxhighlight lang="bracmat">( ( balance
= a x b y c zd
. !arg
Line 58 ⟶ 60:
| insert$!arg
)
);</langsyntaxhighlight>
 
Test:
<langsyntaxhighlight lang="bracmat">( ( it allows for terse code which is easy to read
, and can represent the algorithm directly
.
Line 69 ⟶ 71:
& lst$tree
& done
);</langsyntaxhighlight>
 
Output:
<langsyntaxhighlight lang="bracmat">(tree=
B
. ( B
Line 93 ⟶ 95:
)
)
);</langsyntaxhighlight>
 
=={{header|C++}}==
Line 100 ⟶ 102:
C++ templates have a robust pattern matching facility, with some warts - for example, nested templates cannot be fully specialized, so we must use a dummy template parameter. This implementation uses C++17 deduced template parameters for genericity.
 
<langsyntaxhighlight lang="cpp">enum Color { R, B };
template<Color, class, auto, class> struct T;
struct E;
Line 144 ⟶ 146:
int main() {
print<insert_t<1, insert_t<2, insert_t<0, insert_t<4, E>>>>>();
}</langsyntaxhighlight>
 
===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.
 
<langsyntaxhighlight lang="cpp">#include <memory>
#include <variant>
 
Line 251 ⟶ 253:
t = insert(std::string{argv[i]}, std::move(t));
print(t);
}</langsyntaxhighlight>
 
=={{header|C sharp}}==
Translation of several
{{works with|C sharp|8}}
<langsyntaxhighlight lang="csharp">using System;
 
class Tree
Line 285 ⟶ 287:
 
public void Print(int indent = 0) {
if (this != E) Right.Print(indent + 1);
Console.WriteLine(new string(' ', indent * 4) + ToString());
if (this =!= E) returnLeft.Print(indent + 1);
Left.Print(indent + 1);
Right.Print(indent + 1);
}
 
Line 305 ⟶ 306:
_ => this
};
}</langsyntaxhighlight>
{{out}}
<pre>
[]
[B8]
[B4R16]
[B2]
[B1B15]
[]
[B14]
[]
[B3B13]
[]
[B12]
[]
[B6B11]
[B5]
[]
[]
[B7]
[]
[]
[B12]
[B10]
[]
[B9]
[]
[B8]
[]
[B11B7]
[]
[B6]
[]
[B14B5]
[B13]
[]
[B4]
[]
[B15B3]
[]
[R16B2]
[]
[B1]</pre>
[]</pre>
 
=={{header|Clojure}}==
Line 355 ⟶ 356:
{{libheader|toadstool}}
 
<langsyntaxhighlight lang="lisp">(mapc #'use-package '(#:toadstool #:toadstool-system))
(defstruct (red-black-tree (:constructor tree (color left val right)))
color left val right)
Line 393 ⟶ 394:
(defun insert (x s)
(toad-ecase1 (%insert x s)
((tree t a y b) (tree 'black a y b))))</langsyntaxhighlight>
 
=={{header|E}}==
Line 440 ⟶ 441:
 
=={{header|EchoLisp}}==
<langsyntaxhighlight lang="scheme">
;; code adapted from Racket and Common Lisp
;; Illustrates matching on structures
Line 468 ⟶ 469:
(match (ins x s) [(N _ l v r) (N '⚫️ l v r)]))
</syntaxhighlight>
</lang>
{{out}}
<langsyntaxhighlight lang="scheme">
(define (t-show n (depth 0))
(when (!eq? 'empty n)
Line 479 ⟶ 480:
(define T (for/fold [t 'empty] ([i 32]) (insert (random 100) t)))
(t-show T)
</syntaxhighlight>
</lang>
<small>
<pre>
Line 514 ⟶ 515:
{{trans|Erlang}}
But, it changed an API into the Elixir style.
<langsyntaxhighlight lang="elixir">defmodule RBtree do
def find(nil, _), do: :not_found
def find({ key, value, _, _, _ }, key), do: { :found, { key, value } }
Line 556 ⟶ 557:
|> RBtree.insert(6,-1) |> IO.inspect
|> RBtree.insert(7,0) |> IO.inspect
|> RBtree.find(4) |> IO.inspect</langsyntaxhighlight>
 
{{out}}
Line 577 ⟶ 578:
=={{header|Emacs Lisp}}==
 
The <code>pcase</code> syntaxmacro 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)
<lang lisp>
(defun rbt-balance (tree)
(pcase tree
(`(B (R (R ,a ,x ,b) ,y ,c) ,z ,d) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
Line 607:
(dotimes (i 16)
(setq s (rbt-insert (1+ i) s)))
(pp s))</syntaxhighlight>
</lang>
Output:
 
Line 640 ⟶ 639:
 
The code used here is extracted from [https://gist.github.com/mjn/2648040 Mark Northcott's GitHubGist].
<langsyntaxhighlight lang="erlang">
-module(rbtree).
-export([insert/3, find/2]).
Line 680 ⟶ 679:
balance(T) ->
T.
</syntaxhighlight>
</lang>
 
Output:
Line 714 ⟶ 713:
</pre>
 
=={{header|F_Sharp|F#}}==
<syntaxhighlight lang="fsharp">
// Pattern Matching. Nigel Galloway: January 15th., 2021
type colour= |Red |Black
type rbT<'N>= |Empty |N of colour * rbT<'N> * rbT<'N> * 'N
let repair=function |Black,N(Red,N(Red,ll,lr,lv),rl,v),rr,rv
|Black,N(Red,ll,N(Red,lr,rl,v),lv),rr,rv
|Black,ll,N(Red,N(Red,lr,rl,v),rr,rv),lv
|Black,ll,N(Red,lr,N(Red,rl,rr,rv),v),lv->N(Red,N(Black,ll,lr,lv),N(Black,rl,rr,rv),v)
|i,g,e,l->N(i,g,e,l)
let insert item rbt = let rec insert=function
|Empty->N(Red,Empty,Empty,item)
|N(i,g,e,l) as node->if item>l then repair(i,g,insert e,l) elif item<l then repair(i,insert g,e,l) else node
match insert rbt with N(_,g,e,l)->N(Black,g,e,l) |_->Empty
</syntaxhighlight>
=={{header|Go}}==
{{trans|Kotlin}}
Line 720 ⟶ 734:
 
However, pattern matching on interfaces (via the type switch statement and type assertions) is limited to matching the implementing type and so the balance() method is not very pleasant.
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 837 ⟶ 851:
}
fmt.Println(tr)
}</langsyntaxhighlight>
 
{{out}}
Line 846 ⟶ 860:
=={{header|Haskell}}==
 
<langsyntaxhighlight lang="haskell">data Color = R | B
data Tree a = E | T Color (Tree a) a (Tree a)
 
Line 863 ⟶ 877:
| x > y = balance col a y (ins b)
| otherwise = s
T _ a y b = ins s</langsyntaxhighlight>
 
=={{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 providesrepresents dictionarya functionalitybest usingeffort atranslation of red-blackthe treecurrent writtenHaskell inimplementation Jof withoutthis symbols.task:
 
<syntaxhighlight lang="j">insert=:{{
<lang J>
'R';'';y;a:
help=: noun define
:
red-black tree
if. 0=#y do. insert x
Store dictionary in red-black tree. The keys can be any noun.
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
Reference:
NB. two cascaded reds under a black become two black siblings under a red
Left-leaning Red-Black Trees
balance=: {{
Robert Sedgewick
'C e K w'=. y
Department of Computer Science
if. #e do.
Princeton University
'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:
verbs:
insert key;value Inserts item into tree
delete key Deletes item with key from tree
Deletion via the Sedgewick method is fairly simple.
However, I elected to remove the KEY;VALUE pair
rather than change the tree.
find key Returns the associated definition or EMPTY
items any_noun Returns all the items as a rank 1 array of KEY;VALUE pairs
keys any_noun Returns all the keys as a rank 1 array of boxes
values any_noun Returns all the values as a rank 1 array of boxes
 
<syntaxhighlight lang="j"> 3 insert 2 insert 5
J stores all data as arrays.
┌─┬───────┬─┬───────┐
I chose to use array indexes to implement pointers.
│R│┌─┬┬─┬┐│3│┌─┬┬─┬┐│
An "index" is a rank 0 length 1 array.
│ ││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.
Internal data structure:
 
<syntaxhighlight lang="j">NB. always treat root of tree as black
T This rank 2 array stores indexes of left and right at each branch point.
validate=: {{
C rank 1 array of node color.
if. 0=#y do. 1 return. end.
H rank 1 array of the hash value of each key.
'C e K w'=. y
R rank 0 array stores the root index.
check 'B';e;K;<w
D rank 1 array of boxes. In each box is a rank 2 array of key value
}}
pairs associated with the hash value. Hash collision invokes direct
lookup by key among the keys having same hash.
 
check=: {{
Additional test idea (done):
if. 0=#y do. 1 return. end.
Changing the hash to 0: or 2&| rapidly tests
'C e K w'=. y
hash collision code for integer keys.
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.
bitand=: (#. 1 0 0 0 1)b.
bitxor=: (#. 1 0 1 1 0)b.
hash=: [: ((4294967295) bitand (bitxor 1201&*))/ 846661 ,~ ,@:(a.&i.)@:":
NB. hash=: ] [ 1&bitand NB. can choose simple hash functions for tests
 
For example:
setup=: 3 : 0
T=: i. 0 2 NB. Tree
H=: D=: C=: i. 0 NB. Hashes, Data, Color
R=: _ NB. Root
'BLACK RED'=: i. 2
EMPTY
)
 
<syntaxhighlight lang="j"> ?.~20
setup''
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.)
flipColors=: monad def 'C=: -.@:{`[`]}&C (, {&T) y'
 
=={{header|Java}}==
3 : 0 'test flipColors'
{{trans|Kotlin}}
DD=.D=: ,/<@:(;3j1&":)"0 i.3
{{works with|OpenJDK|21 (Preview)}}
TT=.T=: _ _,0 2,:_ _
CC=.C=: 1 0 1
RR=.R=: 1
HH=.H=: i.3
flipColors R
assert C -: -. CC
assert HH -: H
assert TT -: T
assert DD -: D
assert RR -: R
)
 
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:
getColor=: monad def 'C ({~ :: (BLACK"_))"_ 0 y' NB. y the node
 
<syntaxhighlight lang="java">public class Task {
rotateTree=: dyad define NB. x left or right, y node
enum Color { R, B }
I=. x <@:(, -.)~ y
sealed interface Tree<A extends Comparable<A>> permits E, T {
X=. I { T NB. x = root.otherside
default Tree<A> insert(A a) {
J=. X <@:, x
return switch(ins(a)) {
T=: (J { T) I} T
case T(_, var l, var v, var r) -> new T<>(Color.B, l, v, r);
T=: y J} T
case E() -> new E<>();
C=: y (RED ,~ {)`(X , [)`]} C
};
X
}
)
 
Tree<A> ins(A a);
3 : 0 'test rotateTree'
}
DD=.D=:,/<@:(;3j1&":)"0 i.5
TT=.T=:_ _,0 2,_ _,1 4,:_ _
CC=.C=:0 1 0 0 0
R=:3
HH=.H=:i.5
assert R = rotateTree/0 1 , R
assert DD -: D
assert CC -: C
assert HH -: H
assert TT -: T
)
 
record E<A extends Comparable<A>>() implements Tree<A> {
setup''
@Override
public Tree<A> ins(A a) {
return new T<>(Color.R, new E<>(), a, new E<>());
}
 
@Override
insert_privately=: adverb define
public String toString() { return "E"; }
:
}
ROOT=. m
HASH=. x
ITEM=. y
if. _ -: ROOT do. NB. new key
ROOT=. # H
H=: H , HASH
T=: T , _ _
D=: D , < ,: , ITEM
C=: C , RED
elseif. HASH = ROOT { H do. NB. change a value or hash collision
STACK=. ROOT >@:{ D
I=. STACK i.&:({."1) ITEM
STACK=. ITEM <@:(I}`,@.(I = #@])) STACK
D=: STACK ROOT } D
elseif. do. NB. Follow tree
NB. if both children are red then flipColors ROOT
flipColors^:((,~ RED) -: getColor@:({&T)) ROOT
I=. <@:(, HASH > {&H) ROOT
TEMP=. HASH (I { T) insert_privately y
T=: TEMP I } T
NB.if (isRed(h.right) && !isRed(h.left)) h = rotateLeft(h)
ROOT=. 0&rotateTree^:((BLACK,RED) -: getColor@:({&T)) ROOT
NB.if (isRed(h.left) && isRed(h.left.left)) h = rotateRight(h)
if. RED -: getColor {. ROOT { T do.
if. (RED -: (getColor@:(([: {&T <@:,&0)^:2) :: (BLACK"_))) ROOT do.
ROOT=. 1 rotateTree ROOT
end.
end.
end.
ROOT
)
 
record T<A extends Comparable<A>>(Color color, Tree<A> left,
insert=: monad define"1
A value, Tree<A> right) implements Tree<A> {
assert 'boxed' -: datatype y
@Override
R=: (R insert_privately~ hash@:(0&{::)) y
public Tree<A> ins(A a) {
C=: BLACK R } C
return switch(Integer.valueOf(a.compareTo(value))) {
y
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() {
find_hash_index=: monad define NB. y is the hash
if. 0 = # T do. '' return. end. if (color == NBColor.R) follow thereturn treethis;
I=. R return switch (this) NB. instead of{
while. y ~: I { H do. // unnamed patterns (case T<A>(_, ...)) are a JDK21 NB. directPreview searchfeature
case T<A>(_, T<A>(_, T<A>(_, var a, var x, var b), var y, var c), var z, var d)
J=. <@:(, y > {&H) I
when left instanceof T<A> le && le.left instanceof T<A> le_le &&
if. _ > II=. J { T do. I=. II else. '' return. end.
le.color == Color.R && le_le.color == Color.R ->
end.
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
find=: monad define
public String toString() {
if. '' -: I=. find_hash_index hash y do. EMPTY return. end.
return STR."T[\{color}, \{left}, \{value}, \{right}]"; // String templates are a JDK 21 Preview feature
LIST=. I {:: D
}
K=. {. |: LIST
}
LIST {::~ ::empty 1 ,~ K i. < y
)
 
public static void main(String[] args) {
delete=: 3 : 0
Tree<Integer> tree = new E<>();
if. '' -: I=. find_hash_index hash y do. EMPTY return. end.
for (var i : IntStream.rangeClosed(1, 16).toArray()) {
LIST=. I {:: D
tree = tree.insert(i);
K=. {. |: LIST
J=. K i. < y }
System.out.println(tree);
RESULT=. J ({::~ ,&1)~ LIST
}
STACK=. J <@:({. , (}.~ >:)~) LIST
}
D=. LIST I } D
</syntaxhighlight>
RESULT
{{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}}==
getPathsToLeaves=: a:&$: : (4 : 0) NB. PATH getPathsToLeaves ROOT use: getPathsToLeaves R
'''Adapted from [[#Tcl|Tcl]]'''
if. 0 = # y do. getPathsToLeaves R return. end.
{{works with|jq}}
PATH=. x ,&.> y
'''Works with gojq, the Go implementation of jq'''
if. _ -: y do. return. end.
PATH getPathsToLeaves"0 y { T
)
 
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}`
check=: 3 : 0
can be used as variables in the pattern definitions, and after matching, the corresponding values can be referenced by jq expressions such as `.a`.
COLORS=. getColor"0&.> a: -.~ ~. , getPathsToLeaves ''
result=. EMPTY
if. 0&e.@:(= {.) +/@:(BLACK&=)@>COLORS do. result=. result,<'mismatched black count' end.
if. 1 e. 1&e.@:(*. (= 1&|.))@:(RED&=)@>COLORS do. result=. result,<'successive reds' end.
>result
)
 
Notice also how various features of jq come together to simplify the implementation of the `balance` function.
getPath=: 3 : 0 NB. get path to y, the key
if. 0 = # H do. EMPTY return. end.
HASH=. hash y
PATH=. , I=. R
while. HASH ~: I { H do.
J=. <@:(, HASH > {&H) I
PATH=. PATH , II=. J { T
if. _ > II do. I=. II else. EMPTY return. end.
end.
PATH
)
 
'''bindings.jq'''
items=: 3 :';D'
<syntaxhighlight lang="jq"># bindings($x) attempts to match . and $x structurally on the
keys=: 3 :'0{"1 items y'
# assumption that . is free of JSON objects, and that any objects in
values=: 3 :'1{"1 items y'
# $x will have distinct, singleton keys that are to be interpreted as
</lang>
# variables. These variables will match the corresponding entities in
With use:
# . if . and $x can be structurally matched.
<lang J>
#
load'rb.ijs'
# If . and $x cannot be matched, then null is returned;
NB. populate dictionary in random order with 999 key value pairs
# otherwise, if $x contains no objects, {} is returned;
insert@:(; 6j1&":)"0@:?~ 999
# finally, if . and $x can be structurally matched, a composite object containing the bindings
find 'the' NB. 'the' has no entry.
# will be returned.
find 239 NB. entry 239 has the anticipated formatted string value.
# Output: null (failure to match) or a single JSON object giving the bindings if any.
239.0
def bindings($x):
find 823823 NB. also no such entry
if $x == . then {} # by assumption, no bindings are necessary
NB.
elif ($x|type) == "object"
NB. tree passes the "no consecutive red" and "same number of black"
then ($x|keys) as $keys
NB. nodes to and including NULL leaves.
| if ($keys|length) == 1 then {($keys[0]): .} else "objects should be singletons"|error end
check''
elif type != ($x|type) then null
</lang>
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.
<langsyntaxhighlight lang="julia">import Base.length
 
abstract type AbstractColoredNode end
Line 1,155 ⟶ 1,253:
 
testRB()
</langsyntaxhighlight>{{out}}
<pre>
[B, [R, [B, [R, E, 1, E], 2, [R, E, 3, E]], 4, [B, E, 6, E]], 14, [B, E, 18, E]]]
Line 1,165 ⟶ 1,263:
Whilst Kotlin supports algebraic data types (via 'sealed classes') and destructuring of data classes, pattern matching on them (via the 'when' expression) is currently limited to matching the type. Consequently the balance() function is not very pretty!
<langsyntaxhighlight lang="scala">// version 1.1.51
 
import Color.*
Line 1,248 ⟶ 1,346:
}
println(tree)
}</langsyntaxhighlight>
 
{{out}}
Line 1,254 ⟶ 1,352:
T(B, T(B, T(B, T(B, E, 1, E), 2, T(B, E, 3, E)), 4, T(B, T(B, E, 5, E), 6, T(B, E, 7, E))), 8, T(B, T(B, T(B, E, 9, E), 10, T(B, E, 11, E)), 12, T(B, T(B, E, 13, E), 14, T(B, E, 15, T(R, E, 16, E)))))
</pre>
=={{header|Nim}}==
{{libheader|fusion/matching}}
<syntaxhighlight lang="nim">import fusion/matching
{.experimental: "caseStmtMacros".}
 
type
Colour = enum Empty, Red, Black
RBTree[T] = ref object
colour: Colour
left, right: RBTree[T]
value: T
 
proc `[]`[T](r: RBTree[T], idx: static[FieldIndex]): auto =
## enables tuple syntax for unpacking and matching
when idx == 0: r.colour
elif idx == 1: r.left
elif idx == 2: r.value
elif idx == 3: r.right
 
template B[T](l: untyped, v: T, r): RBTree[T] =
RBTree[T](colour: Black, left: l, value: v, right: r)
 
template R[T](l: untyped, v: T, r): RBTree[T] =
RBTree[T](colour: Red, left: l, value: v, right: r)
 
template balImpl[T](t: typed): untyped =
case t
of (colour: Red | Empty): discard
of (Black, (Red, (Red, @a, @x, @b), @y, @c), @z, @d) |
(Black, (Red, @a, @x, (Red, @b, @y, @c)), @z, @d) |
(Black, @a, @x, (Red, (Red, @b, @y, @c), @z, @d)) |
(Black, @a, @x, (Red, @b, @y, (Red, @c, @z, @d))):
t = R(B(a, x, b), y, B(c, z, d))
 
proc balance*[T](t: var RBTree[T]) = balImpl[T](t)
 
template insImpl[T](t, x: typed): untyped =
template E: RBTree[T] = RBTree[T]()
case t
of (colour: Empty): t = R(E, x, E)
of (value: > x): t.left.ins(x); t.balance()
of (value: < x): t.right.ins(x); t.balance()
 
proc insert*[T](tt: var RBTree[T], xx: T) =
proc ins(t: var RBTree[T], x: T) = insImpl[T](t, x)
tt.ins(xx)
tt.colour = Black</syntaxhighlight>
 
=={{header|OCaml}}==
<langsyntaxhighlight lang="ocaml">
type color = R | B
type 'a tree = E | T of color * 'a tree * 'a * 'a tree
Line 1,281 ⟶ 1,426:
in let T (_,a,y,b) = ins s
in T (B,a,y,b)
</syntaxhighlight>
</lang>
 
=={{header|Oz}}==
Line 1,289 ⟶ 1,434:
To match multiple variables at once, we create temporary tuples with "#".
 
<langsyntaxhighlight lang="oz">fun {Balance Col A X B}
case Col#A#X#B
of b#t(r t(r A X B) Y C )#Z#D then t(r t(b A X B) Y t(b C Z D))
Line 1,312 ⟶ 1,457:
in
t(b A Y B)
end</langsyntaxhighlight>
 
=={{header|Perl}}==
Line 1,325 ⟶ 1,470:
Each of the single letter variables declared right after $balanced, match an instance of $balanced, and if they succeed, store the result into the %+ hash.
 
<langsyntaxhighlight lang="perl">#!perl
use 5.010;
use strict;
Line 1,390 ⟶ 1,535:
}
print "Done\n";
</syntaxhighlight>
</lang>
{{out}}
<pre>Tree: <B,_,9,_>.
Line 1,407 ⟶ 1,552:
There is no formal support for this sort of thing in Phix, but that's not to say that whipping
something up is likely to be particularly difficult, so let's give it a whirl.
<!--<syntaxhighlight lang="phix">(phixonline)-->
 
<span style="color: #000080;font-style:italic;">--
Uses a slightly tweaked version of [[Visualize_a_tree#Phix|Visualize_a_tree]], for the full runnable code
see -- demo\rosetta\Pattern_matching.exw (shipped with 0.8.0+).
-- =================================
 
--
First, imagine the following is in say algebraic_data_types.e. It is not quite generic enough,
-- 1). Lightly modified copy of demo\rosetta\VisualiseTree.exw</span>
and there are too many little fudges, such as that "and not string(ki)", and the use of 0 for
the "any value", and {} to indicate failure, for it to end up in builtins\ as-is, but not exactly
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
difficult to copy/maintain on a per-project basis.
<lang Phix>function match_one(sequence key, object t)
<span style="color: #000080;font-style:italic;">-- To the theme tune of the Milk Tray Ad iyrt,
sequence res = {}
-- All because the Windows console hates utf8:</span>
if sequence(t)
<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>
and length(key)==length(t) then
<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>
for i=1 to length(key) do
<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>
object ki = key[i], ti = t[i]
<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>
if sequence(ki) and not string(ki) then
<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>
sequence r2 = match_one(ki,ti)
if r2={} then res = {} exit end if
<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>
res &= r2
<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>
else
<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>
if ki=0 then
<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>
res = append(res,ti)
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
else
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span>
if ki!=ti then res = {} exit end if
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
end if
<span style="color: #000080;font-style:italic;">--&lt;/hates utf8&gt;</span>
end if
end for
<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>
end if
<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>
return res
<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;">"&lt;empty&gt;\n"</span><span style="color: #0000FF;">)</span>
end function
<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>
/*global*/ function match_algebraic(sequence set, t)
<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>
sequence s
<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>
for i=1 to length(set) do
<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>
s = match_one(set[i],t)
<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>
if length(s) then exit end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end for
<span style="color: #000000;">root</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">g</span>
return s
<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>
end function</lang>
<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>
Then we can code something like this (with include algebraic_data_types.e)
<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>
<lang Phix>constant B = "B", R = "R"
<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>
function balance(sequence t)
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
sequence s = match_algebraic({{B,{R,{R,0,0,0},0,0},0,0},
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
{B,{R,0,0,{R,0,0,0}},0,0},
<span style="color: #000080;font-style:italic;">--&lt;/copy VisualiseTree&gt;
{B,0,0,{R,{R,0,0,0},0,0}},
{B,0,0,{R,0,0,{R,0,0,0}}}},t)
-- 2). Imagine the following is in a file, say algebraic_data_types.e - not quite generic enough
if length(s) then
-- for inclusion in builtins, but not exactly difficult to copy/maintain per-project either.</span>
object {a,x,b,y,c,z,d} = s
t = {R,{B,a,x,b},y,{B,c,z,d}}
<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>
end if
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
return t
<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>
end function
<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>
function ins(object tree, object leaf)
<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>
if tree=NULL then
<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>
tree = {R,NULL,leaf,NULL}
<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>
else
<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>
object {c,l,k,r} = tree
<span style="color: #000000;">res</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">r2</span>
if leaf!=k then
if leaf<k then lspan style="color: ins(l,leaf)#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>
else r = ins(r,leaf)
<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>
end if
tree <span style="color: balance({c,l,k,r})#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>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
return tree
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
 
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
function tree_insert(object tree, object leaf)
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
tree = ins(tree,leaf)
tree[1] = B
<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>
return tree
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span>
end function
<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>
sequence stuff = shuffle(tagset(10))
<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>
object tree = NULL
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
for i=1 to length(stuff) do
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span>
tree = tree_insert(tree,stuff[i])
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
end for
<span style="color: #000080;font-style:italic;">--&lt;/algebraic_data_types.e&gt;
visualise_tree(tree)</lang>
-- 3). The actual task</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">B</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"B"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">R</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"R"</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">balance</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">match_algebraic</span><span style="color: #0000FF;">({{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}},</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}}}},</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">object</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">z</span><span style="color: #0000FF;">,</span><span style="color: #000000;">d</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span>
<span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">},</span><span style="color: #000000;">y</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">B</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">z</span><span style="color: #0000FF;">,</span><span style="color: #000000;">d</span><span style="color: #0000FF;">}}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">t</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">tree</span><span style="color: #0000FF;">=</span><span style="color: #004600;">NULL</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">R</span><span style="color: #0000FF;">,</span><span style="color: #004600;">NULL</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">,</span><span style="color: #004600;">NULL</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">else</span>
<span style="color: #004080;">object</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">l</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">,</span><span style="color: #000000;">r</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">k</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;"><</span><span style="color: #000000;">k</span> <span style="color: #008080;">then</span> <span style="color: #000000;">l</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #000000;">l</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">else</span> <span style="color: #000000;">r</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #000000;">r</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">balance</span><span style="color: #0000FF;">({</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">l</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">,</span><span style="color: #000000;">r</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">tree</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">object</span> <span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ins</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span><span style="color: #000000;">leaf</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">tree</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">B</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">tree</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">stuff</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">shuffle</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">10</span><span style="color: #0000FF;">))</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">NULL</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">stuff</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">tree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tree_insert</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">,</span><span style="color: #000000;">stuff</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000000;">visualise_tree</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tree</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">?</span><span style="color: #008000;">"done"</span>
<span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">wait_key</span><span style="color: #0000FF;">()</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 1,499 ⟶ 1,692:
└B9
└R10
</pre>
 
=={{header|Picat}}==
{{trans|Prolog}}
<syntaxhighlight lang="picat">main =>
T = e,
foreach (X in 1..10)
insert(X,T,T1),
T := T1
end,
output(T,0).
 
insert(X,S,R) =>
ins(X,S,R1),
R1 = $t(_,A,Y,B),
R = $t(b,A,Y,B).
 
ins(X,e,R) => R = $t(r,e,X,e).
ins(X,t(C,A,Y,B),R), X < Y => ins(X,A,Ao), balance(C,Ao,Y,B,R).
ins(X,t(C,A,Y,B),R), X > Y => ins(X,B,Bo), balance(C,A,Y,Bo,R).
ins(_X,T,R) => R = T.
 
balance(C,A,X,B,S) :- (bal(C,A,X,B,T) -> S = T ; S = $t(C,A,X,B)).
 
bal(b, t(r,t(r,A,X,B),Y,C), Z, D, R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
bal(b, t(r,A,X,t(r,B,Y,C)), Z, D, R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
bal(b, A, X, t(r,t(r,B,Y,C),Z,D), R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
bal(b, A, X, t(r,B,Y,t(r,C,Z,D)), R) => R = $t(r,t(b,A,X,B),Y,t(b,C,Z,D)).
 
output(e,Indent) => printf("%*w\n",Indent,e).
output(t(C,A,Y,B),Indent) =>
output(A,Indent+6),
printf("%*w[%w]\n",Indent,C,Y),
output(B,Indent+6).
</syntaxhighlight>
{{out}}
<pre>
e
b[1]
e
b[2]
e
b[3]
e
b[4]
e
b[5]
e
b[6]
e
b[7]
e
r[8]
e
b[9]
e
r[10]
e
</pre>
 
=={{header|PicoLisp}}==
{{trans|Prolog}}
<langsyntaxhighlight PicoLisplang="picolisp">(be color (R))
(be color (B))
 
Line 1,537 ⟶ 1,788:
 
(be insert (@X @S (T B @A @Y @B))
(ins @X @S (T @ @A @Y @B)) )</langsyntaxhighlight>
Test:
<langsyntaxhighlight PicoLisplang="picolisp">: (? (insert 2 E @A) (insert 1 @A @B) (insert 3 @B @C))
@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</langsyntaxhighlight>
 
=={{header|Prolog}}==
Line 1,565 ⟶ 1,816:
 
insert(X,S,t(b,A,Y,B)) :- ins(X,S,t(_,A,Y,B)).
</pre>
 
=={{header|Python}}==
{{trans|C#}}
 
Structural pattern matching was added to Python in version 3.10.
 
<syntaxhighlight lang="python">from __future__ import annotations
from enum import Enum
from typing import NamedTuple
from typing import Optional
 
 
class Color(Enum):
B = 0
R = 1
 
 
class Tree(NamedTuple):
color: Color
left: Optional[Tree]
value: int
right: Optional[Tree]
 
def insert(self, val: int) -> Tree:
return self._insert(val).make_black()
 
def _insert(self, val: int) -> Tree:
match compare(val, self.value):
case _ if self == EMPTY:
return Tree(Color.R, EMPTY, val, EMPTY)
case -1:
assert self.left is not None
return Tree(
self.color, self.left._insert(val), self.value, self.right
).balance()
case 1:
assert self.right is not None
return Tree(
self.color, self.left, self.value, self.right._insert(val)
).balance()
case _:
return self
 
def balance(self) -> Tree:
match self:
case (Color.B, (Color.R, (Color.R, a, x, b), y, c), z, d):
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
case (Color.B, (Color.R, a, x, (Color.R, b, y, c)), z, d):
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
case (Color.B, a, x, (Color.R, (Color.R, b, y, c), z, d)):
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
case (Color.B, a, x, (Color.R, b, y, (Color.R, c, z, d))):
return Tree(Color.R, Tree(Color.B, a, x, b), y, Tree(Color.B, c, z, d))
case _:
return self
 
def make_black(self) -> Tree:
return self._replace(color=Color.B)
 
def __str__(self) -> str:
if self == EMPTY:
return "[]"
return f"[{'R' if self.color == Color.R else 'B'}{self.value}]"
 
def print(self, indent: int = 0) -> None:
if self != EMPTY:
assert self.right is not None
self.right.print(indent + 1)
 
print(f"{' ' * indent * 4}{self}")
 
if self != EMPTY:
assert self.left is not None
self.left.print(indent + 1)
 
 
EMPTY = Tree(Color.B, None, 0, None)
 
 
def compare(x: int, y: int) -> int:
if x > y:
return 1
if x < y:
return -1
return 0
 
 
def main():
tree = EMPTY
for i in range(1, 17):
tree = tree.insert(i)
tree.print()
 
 
if __name__ == "__main__":
main()
</syntaxhighlight>
 
{{out}}
<pre>
[]
[R16]
[]
[B15]
[]
[B14]
[]
[B13]
[]
[B12]
[]
[B11]
[]
[B10]
[]
[B9]
[]
[B8]
[]
[B7]
[]
[B6]
[]
[B5]
[]
[B4]
[]
[B3]
[]
[B2]
[]
[B1]
[]
</pre>
 
Line 1,570 ⟶ 1,955:
{{trans|OCaml}}
 
<langsyntaxhighlight lang="racket">
#lang racket
 
Line 1,603 ⟶ 1,988:
 
(visualize (for/fold ([t 'empty]) ([i 16]) (insert i t)))
</syntaxhighlight>
</lang>
 
<pre>
Line 1,628 ⟶ 2,013:
{{works with|rakudo|2016.11}}
Raku doesn't have algebraic data types (yet), but it does have pretty good pattern matching in multi signatures.
<syntaxhighlight lang="raku" perl6line>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]] }
Line 1,652 ⟶ 2,037:
$t = insert($_, $t) for (1..10).pick(*);
say $t.gist;
}</langsyntaxhighlight>
This code uses generic comparison operators <tt>before</tt> and <tt>after</tt>, so it should work on any ordered type.
{{out}}
Line 1,664 ⟶ 2,049:
 
An abstract pattern is recursively defined and may contain, among others, the following elements: Literal, VariableDeclaration, MultiVariable, Variable, List, Set, Tuple, Node, Descendant, Labelled, TypedLabelled, TypeConstrained. More explanation can be found in the [http://http://tutor.rascal-mpl.org/Courses/Rascal/Rascal.html#/Courses/Rascal/Patterns/Abstract/Abstract.html Documentation]. Some examples:
<langsyntaxhighlight lang="rascal">
// Literal
rascal>123 := 123
Line 1,729 ⟶ 2,114:
Match black(leaf(3),leaf(4))
Match black(leaf(5),leaf(4))
list[void]: []</langsyntaxhighlight>
 
===Concrete===
Line 1,736 ⟶ 2,121:
 
A concrete pattern is a quoted concrete syntax fragment that may contain variables. The syntax that is used to parse the concrete pattern may come from any module that has been imported in the module in which the concrete pattern occurs. Some examples of concrete patterns:
<langsyntaxhighlight lang="rascal">// Quoted pattern
` Token1 Token2 ... Tokenn `
// A typed quoted pattern
Line 1,743 ⟶ 2,128:
<Type Var>
// A variable pattern
<Var></langsyntaxhighlight>
 
A full example of concrete patterns can be found in the [http://tutor.rascal-mpl.org/Courses/Recipes/Languages/Exp/Concrete/WithLayout/WithLayout.html Rascal Recipes].
Line 1,751 ⟶ 2,136:
There are two variants of the PatternsWitchAction. When the subject matches Pattern, the expression Exp is evaluated and the subject is replaced with the result. Secondly, when the subject matches Pattern, the (block of) Statement(s) is executed. See below for some ColoredTree examples:
 
<langsyntaxhighlight lang="rascal">// Define ColoredTrees with red and black nodes and integer leaves
data ColoredTree = leaf(int N)
| red(ColoredTree left, ColoredTree right)
Line 1,790 ⟶ 2,175:
case red(l, r) => green(l, r)
};
}</langsyntaxhighlight>
 
===Regular Expressions===
Line 1,796 ⟶ 2,181:
Regular expressions are noated between two slashes. Most normal regular expressions patterns are available, such as ., \n, \d, etc. Additionally, flags can be used to create case intensiveness.
 
<langsyntaxhighlight lang="rascal">rascal>/XX/i := "some xx";
bool: true
rascal>/a.c/ := "abc";
bool: true</langsyntaxhighlight>
 
=={{header|REXX}}==
The nodes used for this example are taken from the Wikipedia example at: &nbsp;
[[https://en.wikipedia.org/wiki/Red%E2%80%93black_tree#/media/File:Red-black_tree_example.svg red black tree, an example]]
<langsyntaxhighlight lang="rexx">/*REXX pgm builds a red/black tree (with verification & validation), balancesbalanced 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.*/
top=.
call Dnodes nodes /*define nodes, balance them as added. */
call Dnodes insert /*insert nodes, balance them" as " " " needed.*/
call Lnodes /*list the nodes (with indentationindentations). */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
Dnodeserr: arg $d say; do j=1 for words say '***error***: ' arg($d1); t=word($d, j) /*color:say; encoded into LEV.*/ exit 13
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
/*──────────────────────────────────────────────────────────────────────────────────────*/
errDnodes: arg say$d; do j=1 for say '***error***: ' argwords(1$d); t= word($d, j) /*color: say;encoded into L. exit 13*/
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 the Y integerint.: 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</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
Line 1,855 ⟶ 2,240:
{{trans|Haskell}}
This would be a horribly inefficient way to implement a Red-Black Tree in Rust as nodes are being allocated and deallocated constantly, but it does show off Rust's pattern matching.
<langsyntaxhighlight lang="rust">#![feature(box_patterns, box_syntax)]
use self::Color::*;
use std::cmp::Ordering::*;
Line 1,897 ⟶ 2,282:
}
}
}</langsyntaxhighlight>
 
=={{header|Scala}}==
Line 1,932 ⟶ 2,317:
of that object.
 
<langsyntaxhighlight lang="scala">class RedBlackTree[A](implicit ord: Ordering[A]) {
sealed abstract class Color
case object R extends Color
Line 1,964 ⟶ 2,349:
}
}
}</langsyntaxhighlight>
 
Usage example:
Line 1,981 ⟶ 2,366:
 
=={{header|Standard ML}}==
<langsyntaxhighlight lang="sml">
datatype color = R | B
datatype 'a tree = E | T of color * 'a tree * 'a * 'a tree
Line 2,006 ⟶ 2,391:
T (B,a,y,b)
end
</syntaxhighlight>
</lang>
 
=={{header|Swift}}==
{{works with|Swift|2+}}
<langsyntaxhighlight lang="swift">enum Color { case R, B }
enum Tree<A> {
case E
Line 2,046 ⟶ 2,431:
return .E
}
}</langsyntaxhighlight>
 
=={{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 2,052 ⟶ 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:
<langsyntaxhighlight lang="tcl"># From http://wiki.tcl.tk/9547
package require Tcl 8.5
package provide datatype 0.1
Line 2,122 ⟶ 2,565:
proc default body { return -code return [list {} $body] }
}
</syntaxhighlight>
</lang>
We can then code our solution similar to Haskell:
 
<langsyntaxhighlight lang="tcl">datatype define Color = R | B
datatype define Tree = E | T color left val right
 
Line 2,154 ⟶ 2,597:
}
}
}</langsyntaxhighlight>
 
=={{header|TXR}}==
 
TXR Lisp has structural pattern matching on objects of all kinds, including structures. We define a red-black tree structure like this, with a BOA constructor (by-order of arguments) for convenience:
 
<syntaxhighlight lang="txrlisp">
(defstruct (rbnode color left right data) ()
color
left
right
data)
</syntaxhighlight>
 
The empty tree case is handled by the <code>nil</code> symbol, so in terms of algebraic types, the tree is a sum of <code>nil</code> and the <code>rbnode</code> struct type, and that struct type is a product type of several properties. For the <code>color</code> slot, we use the keyword symbols <code>:red</code> and <code>:black</code> which needs not be declared anywhere. <code>data</code> can be any value.
 
TXR Lisp's syntax for matching structures looks like this:
 
<syntaxhighlight lang="txrlisp">
@(struct time year @y month @m)
</syntaxhighlight>
 
This example matches a time structure instance, capturing the year as <code>y</code>
and month as <code>m</code>.
 
Structures aren't ordered tuples; they are clumps of of named slots,
that cannot be accessed by position. This would break under
inheritance, in particular multiple inheritance.
 
Furthermore, variables have the <code>@</code> sigil in most pattern matching
constructs, because symbols without the sigil denote themselves as literal
patterns. The pattern <code>x</code> matches the symbol <code>x</code>
literally, and no other object. The pattern <code>@x</code> matches any
object and captures it as <code>x</code>.
 
These above features make it verbose and somewhat noisy to express
pattern matching of our <code>rbtree</code> node. However, TXR Lisp's
pattern matching sublanguage supports application-defined macro patterns,
defined by the <code>defmatch</code> macro. With these we can achieve
a shorthand notation which matches nodes as if they were ordered tuples,
and which drops the sigils from variables.
 
<syntaxhighlight lang="txrlisp">
(defmatch rb (color left right data)
(flet ((var? (sym) (if (bindable sym) ^@,sym sym)))
^@(struct rbnode
color ,(var? color)
left ,(var? left)
right ,(var? right)
data ,(var? data))))
 
(defmatch red (left right data)
^@(rb :red ,left ,right ,data))
 
(defmatch black (left right data)
^@(rb :black ,left ,right ,data))
</syntaxhighlight>
 
And with all the above, we can write the code like this:
 
<syntaxhighlight lang="txrlisp">
(defun-match rb-balance
((@(or @(black @(red @(red a b x) c y) d z)
@(black @(red a @(red b c x) x) d z)
@(black a @(red @(red b c y) d z) x)
@(black a @(red b @(red c d z) y) x)))
(new (rbnode :red
(new (rbnode :black a b x))
(new (rbnode :black c d z))
y)))
((@else) else))
 
(defun rb-insert-rec (tree x)
(match-ecase tree
(nil
(new (rbnode :red nil nil x)))
(@(rb color a b y)
(cond
((< x y)
(rb-balance (new (rbnode color (rb-insert-rec a) b y))))
((> x y)
(rb-balance (new (rbnode color a (rb-insert-rec b) y))))
(t tree)))))
 
(defun rb-insert (tree x)
(match-case (rb-insert-rec tree x)
(@(red a b y) (new (rbnode :black a b y)))
(@else else)))
</syntaxhighlight>
 
Insertion is split into two functions: a recursive one which works on its own, except that whenever the tree ends up with a red root, we would like to rewrite that node to a black one. We make the insertion function call the recursive one and then do this fix-up using pattern matching again.
 
=={{header|Wren}}==
{{trans|Go}}
Wren doesn't have either algebraic data types or pattern matching though, despite that, the ''T.balance()'' method looks better than I thought it would :)
<syntaxhighlight lang="wren">var R = "R"
var B = "B"
 
class Tree {
ins(x) {} // overridden by child classes
 
insert(x) { // inherited by child classes
var t = ins(x)
if (t.type == T) return T.new(B, t.le, t.aa, t.ri)
if (t.type == E) return E.new()
return null
}
}
 
class T is Tree {
construct new(cl, le, aa, ri) {
_cl = cl // color
_le = le // Tree
_aa = aa // integer
_ri = ri // Tree
}
 
cl { _cl }
le { _le }
aa { _aa }
ri { _ri }
 
balance() {
if (_cl != B) return this
 
var le2 = _le.type == T ? _le : null
var lele
var leri
if (le2) {
lele = _le.le.type == T ? _le.le : null
leri = _le.ri.type == T ? _le.ri : null
}
var ri2 = _ri.type == T ? _ri : null
var rile
var riri
if (ri2) {
rile = _ri.le.type == T ? _ri.le : null
riri = _ri.ri.type == T ? _ri.ri : null
}
 
if (le2 && lele && le2.cl == R && lele.cl == R) {
var t = le2.le
return T.new(R, T.new(B, t.le, t.aa, t.ri), le2.aa, T.new(B, le2.ri, _aa, _ri))
}
if (le2 && leri && le2.cl == R && leri.cl == R) {
var t = le2.ri
return T.new(R, T.new(B, le2.le, le2.aa, t.le), t.aa, T.new(B, t.ri, _aa, _ri))
}
if (ri2 && rile && ri2.cl == R && rile.cl == R) {
var t = ri2.ri
return T.new(R, T.new(B, _le, _aa, t.le), t.aa, T.new(B, t.ri, ri2.aa, ri2.ri))
}
if (ri2 && riri && ri2.cl == R && riri.cl == R) {
var t = ri2.ri
return T.new(R, T.new(B, _le, _aa, ri2.le), ri2.aa, T.new(B, t.le, t.aa, t.ri))
}
return this
}
 
ins(x) {
if (x < _aa) return T.new(_cl, _le.ins(x), _aa, _ri).balance()
if (x > _aa) return T.new(_cl, _le, _aa, _ri.ins(x)).balance()
return this
}
 
toString { "T(%(_cl), %(_le), %(_aa), %(_ri))" }
}
 
class E is Tree {
construct new() {}
 
ins(x) { T.new(R, E.new(), x, E.new()) }
 
toString { "E" }
}
 
var tr = E.new()
for (i in 1..16) tr = tr.insert(i)
System.print(tr)</syntaxhighlight>
 
{{out}}
<pre>
T(B, T(B, T(B, T(B, E, 1, E), 2, T(B, E, 3, E)), 4, T(B, T(B, E, 5, E), 6, T(B, E, 7, E))), 8, T(B, T(B, T(B, E, 9, E), 10, T(B, E, 11, E)), 12, T(B, T(B, E, 13, E), 14, T(B, E, 15, T(R, E, 16, E)))))
</pre>
 
{{omit from|Ada}}
{{omit from|BBC BASIC}}
{{omit from|C}}
{{omit from|Java}}
{{omit from|Pascal}}
{{omit from|Processing}}
{{omit from|Python}}
{{omit from|TI-83 BASIC}}
{{omit from|TI-89 BASIC}}
Anonymous user