Algebraic data types
Some languages offer direct support for 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.
You are encouraged to solve this task according to the task description, using any language you may know.
As an example, implement insertion in a 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.
E
In E, a pattern can be used almost anywhere a variable name can. Additionally, there are two operators used for pattern matching idioms: =~ (returns success as a boolean, somewhat like Perl's =~), and switch (matches multiple patterns, like Haskell's case).
Both of those operators are defined in terms of the basic bind/match operation: def pattern exit failure_handler := specimen
def balance(tree) { return if ( tree =~ term`tree(black, tree(red, tree(red, @a, @x, @b), @y, @c), @z, @d)` || tree =~ term`tree(black, tree(red, @a, @x, tree(red, @b, @y, @c)), @z, @d)` || tree =~ term`tree(black, @a, @x, tree(red, tree(red, @b, @y, @c), @z, @d))` || tree =~ term`tree(black, @a, @x, tree(red, @b, @y, tree(red, @c, @z, @d)))` ) { term`tree(red, tree(black, $a, $x, $b), $y, tree(black, $c, $z, $d))` } else { tree } } def insert(elem, tree) { def ins(tree) { return switch (tree) { match term`empty` { term`tree(red, empty, $elem, empty)` } match term`tree(@color, @a, @y, @b)` { if (elem < y) { balance(term`tree($color, ${ins(a)}, $y, $b)`) } else if (elem > y) { balance(term`tree($color, $a, $y, ${ins(b)})`) } else { tree } } } } def term`tree(@_, @a, @y, @b)` := ins(tree) return term`tree(black, $a, $y, $b)` }
This code was tested by filling a tree with random values; you can try this at the E REPL:
? var tree := term`empty` > for _ in 1..20 { > tree := insert(entropy.nextInt(100), tree) > } > tree
Haskell
<lang haskell>data Color = R | B data Tree a = E | T Color (Tree a) a (Tree a)
balance :: Color -> Tree a -> a -> Tree a -> Tree a balance B (T R (T R a x b) y c ) z d = T R (T B a x b) y (T B c z d) balance B (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d) balance B a x (T R (T R b y c) z d ) = T R (T B a x b) y (T B c z d) balance B a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d) balance col a x b = T col a x b
insert :: Ord a => a -> Tree a -> Tree a insert x s = T B a y b where
ins E = T R E x E ins s@(T col a y b) | x < y = balance col (ins a) y b | x > y = balance col a y (ins b) | otherwise = s T _ a y b = ins s</lang>
OCaml
<lang ocaml> type color = R | B type 'a tree = E | T of color * 'a tree * 'a * 'a tree
(** val balance : color * 'a tree * 'a * 'a tree -> 'a tree *) let balance = function
| B, T (R, T (R,a,x,b), y, c), z, d | B, T (R, a, x, T (R,b,y,c)), z, d | B, a, x, T (R, T (R,b,y,c), z, d) | B, a, x, T (R, b, y, T (R,c,z,d)) -> T (R, T (B,a,x,b), y, T (B,c,z,d)) | col, a, x, b -> T (col, a, x, b)
(** val insert : 'a -> 'a tree -> 'a tree *) let insert x s =
let rec ins = function | E -> T (R,E,x,E) | T (col,a,y,b) as s ->
if x < y then balance (col, ins a, y, b) else if x > y then balance (col, a, y, ins b) else s
in let T (_,a,y,b) = ins s in T (B,a,y,b)
</lang>
Prolog
color(r). color(b). tree(_,e). tree(P,t(C,L,X,R)) :- color(C), tree(P,L), call(P,X), tree(P,R). bal(b, t(r,t(r,A,X,B),Y,C), Z, D, 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, 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), 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)), t(r,t(b,A,X,B),Y,t(b,C,Z,D))). balance(C,A,X,B,S) :- ( bal(C,A,X,B,T) -> S = T ; S = t(C,A,X,B) ). ins(X,e,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) ; X > Y -> ins(X,B,Bo), balance(C,A,Y,Bo,R) ; X = Y -> R = t(C,A,Y,B) ). insert(X,S,t(b,A,Y,B)) :- ins(X,S,t(_,A,Y,B)).
Standard ML
<lang sml> datatype color = R | B datatype 'a tree = E | T of color * 'a tree * 'a * 'a tree
(** val balance = fn : color * 'a tree * 'a * 'a tree -> 'a tree *) fun balance (B, T (R, T (R,a,x,b), y, c), z, d) = T (R, T (B,a,x,b), y, T (B,c,z,d))
| balance (B, T (R, a, x, T (R,b,y,c)), z, d) = T (R, T (B,a,x,b), y, T (B,c,z,d)) | balance (B, a, x, T (R, T (R,b,y,c), z, d)) = T (R, T (B,a,x,b), y, T (B,c,z,d)) | balance (B, a, x, T (R, b, y, T (R,c,z,d))) = T (R, T (B,a,x,b), y, T (B,c,z,d)) | balance (col, a, x, b) = T (col, a, x, b)
(** val insert = fn : int -> int tree -> int tree *) fun insert x s = let
fun ins E = T (R,E,x,E) | ins (s as T (col,a,y,b)) =
if x < y then balance (col, ins a, y, b) else if x > y then balance (col, a, y, ins b) else s
val T (_,a,y,b) = ins s
in
T (B,a,y,b)
end </lang>
Tcl
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: <lang tcl># From http://wiki.tcl.tk/9547 package require Tcl 8.5 package provide datatype 0.1
namespace eval ::datatype {
namespace export define match matches namespace ensemble create
# Datatype definitions proc define {type = args} { set ns [uplevel 1 { namespace current }] foreach cons [split [join $args] |] { set name [lindex $cons 0] set args [lrange $cons 1 end] proc $ns\::$name $args [format { lreplace [info level 0] 0 0 %s } [list $name]] } return $type }
# Pattern matching # matches pattern value envVar -- # Returns 1 if value matches pattern, else 0 # Binds match variables in envVar proc matches {pattern value envVar} { upvar 1 $envVar env if {[var? $pattern]} { return [bind env $pattern $value] } if {[llength $pattern] != [llength $value]} { return 0 } if {[lindex $pattern 0] ne [lindex $value 0]} { return 0 } foreach pat [lrange $pattern 1 end] val [lrange $value 1 end] { if {![matches $pat $val env]} { return 0 } } return 1 } # A variable starts with lower-case letter or _. _ is a wildcard. proc var? term { string match {[a-z_]*} $term } proc bind {envVar var value} { upvar 1 $envVar env if {![info exists env]} { set env [dict create] } if {$var eq "_"} { return 1 } dict set env $var $value return 1 } proc match args { #puts "MATCH: $args" set values [lrange $args 0 end-1] set choices [lindex $args end] append choices \n [list return -code error -level 2 "no match for $values"] set f [list values $choices [namespace current]] lassign [apply $f $values] env body #puts "RESULT: $env -> $body" dict for {k v} $env { upvar 1 $k var; set var $v } catch { uplevel 1 $body } msg opts dict incr opts -level return -options $opts $msg } proc case args { upvar 1 values values set patterns [lrange $args 0 end-2] set body [lindex $args end] set env [dict create] if {[llength $patterns] != [llength $values]} { return } foreach pattern $patterns value $values { if {![matches $pattern $value env]} { return } } return -code return [list $env $body] } proc default body { return -code return [list {} $body] }
} </lang> We can then code our solution similar to Haskell:
<lang tcl> datatype define Color = R | B datatype define Tree = E | T color left val right
- balance :: Color -> Tree a -> a -> Tree a -> Tree a
proc balance {color left val right} {
datatype match $color $left $val $right { case B [T R [T R a x b] y c] z d -> { T R [T B $a $x $b] $y [T B $c $z $d] } case B [T R a x [T R b y c]] z d -> { T R [T B $a $x $b] $y [T B $c $z $d] } case B a x [T R [T R b y c] z d] -> { T R [T B $a $x $b] $y [T B $c $z $d] } case B a x [T R b y [T R c z d]] -> { T R [T B $a $x $b] $y [T B $c $z $d] } case col a x b -> { T $col $a $x $b } }
}
- insert :: Ord a => a -> Tree a -> Tree a
proc insert {x s} {
datatype match [ins $x $s] { case [T _ a y b] -> { T B $a $y $b } }
}
- ins :: Ord a => a -> Tree a -> Tree a
proc ins {x s} {
datatype match $s { case E -> { T R E $x E } case [T col a y b] -> { if {$x < $y} { return [balance $col [ins $x $a] $y $b] } if {$x > $y} { return [balance $col $a $y [ins $x $b]] } return $s } }
} </lang>