Algebraic data types: Difference between revisions

From Rosetta Code
Content added Content deleted
(added standard ml)
Line 73: Line 73:


=={{header|OCaml}}==
=={{header|OCaml}}==
<pre lang="OCaml">
<lang ocaml>
type color = R | B
type color = R | B
type 'a tree = E | T of color * 'a tree * 'a * 'a tree
type 'a tree = E | T of color * 'a tree * 'a * 'a tree


(** val balance :: color * 'a tree * 'a * 'a tree -> 'a tree *)
(** val balance : color * 'a tree * 'a * 'a tree -> 'a tree *)
let balance = function
let balance = function
| B, T (R, T (R,a,x,b), y, c), z, d
| B, T (R, T (R,a,x,b), y, c), z, d
Line 85: Line 85:
| col, a, x, b -> T (col, a, x, b)
| col, a, x, b -> T (col, a, x, b)


(** val insert :: 'a -> 'a tree -> 'a tree *)
(** val insert : 'a -> 'a tree -> 'a tree *)
let insert x s =
let insert x s =
let rec ins = function
let rec ins = function
Line 91: Line 91:
| T (col,a,y,b) as s ->
| T (col,a,y,b) as s ->
if x < y then
if x < y then
balance (col, (ins a), y, b)
balance (col, ins a, y, b)
else if x > y then
else if x > y then
balance (col, a, y, (ins b))
balance (col, a, y, ins b)
else
else
s
s
in let T (_,a,y,b) = ins s
in let T (_,a,y,b) = ins s
in T (B,a,y,b)
in T (B,a,y,b)
</pre>
</lang>


=={{header|Prolog}}==
=={{header|Prolog}}==
Line 123: Line 123:
insert(X,S,t(b,A,Y,B)) :- ins(X,S,t(_,A,Y,B)).
insert(X,S,t(b,A,Y,B)) :- ins(X,S,t(_,A,Y,B)).
</pre>
</pre>

=={{header|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>

Revision as of 09:07, 21 March 2009

Task
Algebraic data types
You are encouraged to solve this task according to the task description, using any language you may know.

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.

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

Translation of: Haskell

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>