Functional Programming Examples: Recursion, Streams, and More

Bisection Method & Polynomial Root Finding

fun bisection (f,a,b) =
let val mid = (a+b) / 2.0 in
if Math.abs (a-b) < 0.00001 then mid
else
if (f mid) * (f a) < 0.0 then bisection (f,a,mid)
else bisection (f,mid,b)
fun mypoly x = x*x*x -7
val root = bisection (mypoly, 6.0, 0.0, 7.0)

Cube and Sum of Cubes

fun cube a = a*a*a
fun sumCubes (a,b) =
if (a>b) then 0 else cube (a) + sumCubes (a+1,b)

Tree Traversal and Filtering

fun gather (p : int -> bool) (T : string tree) (cont : (int * string) list -> 'a) : 'a =
case T of
Empty => cont []
| Node ((n,s),L,R) =>
if p(n) then
gather p L (fn lst_L => gather p R (fn lst_R => cont (lst_L @ [(n,s)] @ lst_R )))
else
gather p L (fn lst_L => gather p R (fn lst_R => cont (lst_L @ lst_R)))

List Operations: Sum, Reverse, Factorial

fun sum_tr lst =
let fun sum' (lst', acc) =
case lst' of
[] => acc
| h::t => sum' (t, h+acc)
in
sum' (lst,0)
end
fun rev lst = case lst of [] =>[]
|x::xs=> (rev xs) @ [x]
fun rev_tr lst =
let fun rev' (lst, acc) =
case lst of
[] => acc
| h::t => rev'(t, h::acc)
in
rev' (lst,[])
end
fun fact_tr n =
let fun factTC (n,acc) = if n = 0 then acc
else factTC(n-1, acc*n)
in factTC (n,1)
end

Streams in Functional Programming

datatype 'a stream = STREAM of unit -> ('a * 'a stream)
fun force (STREAM s) = s()
(*force the computation held in the stream *)
fun nums_from n = STREAM (fn () => (n, nums_from (n+1)))
val num10 = nums_from 10
(*by doing force stream, it gives (10, STREAM fn).
w/o force, it just returns stream.
so stream is suspended until it is forced to be called.*)
fun take n s = if n=0 then []
else let val (x,L) = force s
in
x::(take (n-1) L)
end
fun mapstream f s = STREAM (fn () => let val (x,L) = force s in
(f x, mapstream f L) end);
fun filter p s = STREAM (fn () => let val (x,L) = force s in
if (x mod p) = 0
then force (filter p L)
else (x, filter p L)
end)
fun sieve s = STREAM (fn () => let val (x,L) = force s in (x, sieve(filter x L))end )

Binary Tree Operations: Insert, Find, Height, Depth

datatype 'a tree = Empty | Node of 'a * 'a tree * 'a tree
fun insert (n, tree) = case tree of
Empty => Node (n, Empty, Empty)
| Node(m,l,r) => if (n<m) then Node (m, insert (n,l), r)
else Node (m, l ,insert (n,r))
fun find (n, t) = case t of
Empty => false
| Node(m,l,r) => if (n=m) then true
else if(n<m) then find (n,l)
else find (n,r)
fun max (n,m) = if n>m then n else m
fun height t = case t of Empty => 0
| Node(n,l,r) => 1+max(height l, height r)
fun depth (t,d) = case t of Empty => []
| Node(n,l,r) => [(n,d)] @ depth (l,d+1) @ depth (r,d+1)

Continuation Passing Style & Tree Search

fun sum_CPS lst k =
case lst of
[] => k 0
| h::t => sum_CPS t (fn s => k (h+s))
datatype 'a tree = Empty | Node of 'a tree * 'a * 'a tree
fun findCPS p T cont =
case T of
Empty => cont()
| Node (L,d,R) => if (p d) then SOME d
else findCPS p L (fn () => findCPS p R cont)
(* this function take nothing *)
val x = findCPS (fn x => x=7) Empty (fn () => NONE)

Reference Lists and Mutable Data

datatype 'a rlist = Empty | RCons of 'a * (('a rlist) ref)
val L1 = ref (RCons(4, ref Empty))
val L2 = ref (RCons(5, L1))
val _ = L1 := !L2
fun observe (L, n) =
case L of
Empty => print "0"
| RCons(x, L) =>
if n = 0 then print "STOP \n"
else (print (Int.toString (x) ^ " "); observe (!L, n-1))
val test = ref (RCons(4, ref Empty))
val test2 = ref (RCons(2,ref Empty))
val test3 = test := Empty

Currying and Church Numerals

fun pow x =
fn (y) => case y of
0 => 1
| _ => x*(pow x (y-1) )
(*church *)
type 'a church = ('a -> 'a) * 'a -> 'a
(* 0 is represented as fn (f,x) => x
1 is represented as fn (f,x) => f(x)
2 is represented as fn (f,x) => f(f(x)) *)
val church_0 : 'a church = fn (f, x) => x
val church_1 : 'a church = fn (f, x) => f x
val church_2 : 'a church = fn (f, x) => f (f x)
val church_3 : 'a church = fn (f, x) => f (f (f x))

Staging and Curried Exponentiation

fun exp e =
fn b => case e of
0 =>1
| _ => b* (exp (e-1) b)
val square = exp 2 (*exp 2 #*)
val cube = exp 3 (*exp 3 # *)
fun staged_exp e =
case e of
0 => (fn _ => 1)
| _ => let val onestep = staged_exp (e-1)
in
fn b => b * onestep b
end

Counters Using References and Datatypes

fun counter () =
let val counter = ref 0
fun tick () = (counter := !counter +1; !counter)
fun reset () = (counter := 0)
in
{t = tick, r = reset} (*records*)
end
datatype sdd = tick | reset
fun counter' () =
let val counter = ref 0 in
fn types => case types of
tick => (counter := !counter + 1; !counter)
| reset => ((counter := 0); !counter )
end
val c1 = counter ()

Higher-Order Functions: Filter, Map, Fold

fun filter (p,lst) =
case lst of
[] => []
| x::xs => if p x then x::filter (p, xs)
else filter(p, xs)
fun map f =
fn lst => case lst of
[] => []
| h::t => f h :: map f t
fun foldl (f,acc,lst) =
case lst of
[] => acc
| h::t => foldl (f, f(h,acc), t)
fun foldr (f, acc, lst) = case lst of [] => acc | h::t => f(h, foldr(f, acc, t))
fun length lst = foldl (op+, 0, (map(fn x=>1) lst))

Exceptions and Tree Traversal

exception Error of string
fun fact n = let fun f n = if n = 0 then 1 else n* f(n-1) in
if n<0 then raise Error "n<0 \n"
else f(n)
end
fun runFact n = let val r = fact(n) in
print ( Int.toString r)
end
handle Error msg=> print ("Error: Invariant violated --" ^msg)
fun collect (p: int -> bool) (T: string tree) : (int * string) list =
case T of Empty => []
| Node ((n,s),L,R) =>
let val tl = collect p L handle Found lst => lst
val tr = collect p R handle Found lst => lst
in
if p(n) then raise Found (tl @ (n,s) :: tr)
else raise Found (tl @ tr)
end
handle Found lst => lst

Reference Lists, Insertion, and Bank Accounts

datatype 'a rlist = Empty | RCons of 'a * (('a rlist) ref)
fun insert (comp : 'a * 'a -> bool) (x : 'a) (lst : ('a rlist ref)) : unit =
case !lst of
Empty => lst := RCons (x, ref Empty)
| RCons (y, ys) => if comp(x,y)
then lst := RCons (x, ref (RCons (y, ys)))
else insert comp x ys
datatype transactions = Withdraw of int | Deposit of int |Check_balance
fun make_account (op_balance:int, pass) =
let val balance = ref op_balance in
fn (trans,PW_check) => if (PW_check = pass) then
case trans of
Withdraw (a) => ((balance := !balance-a); !balance)
| Deposit (a) => ((balance := !balance+a); !balance)
| Check_balance => (!balance)
end;

Tree Traversal and Exception Handling

datatype 'a tt = Empty | Leaf of 'a | Node of 'a tt * 'a tt
fun oddP n = case n mod 2 of 1 => true
| _ => false
exception NoOdd
fun findOdd t =
case t of
Empty => raise NoOdd
| Leaf x => (case oddP x of true => x
| false => raise NoOdd)
| Node (l,r) => (findOdd l) handle NoOdd => findOdd r
exception Found of int
fun find_prop t =
case t of
Empty => ()
|Leaf x => (case oddP x of true => raise Found x
| false => ())
| Node(l,r) => let val check_R_L = find_prop l in find_prop r end

Lazy Evaluation with Suspensions

(*stream*)
datatype 'a susp = Susp of (unit -> 'a)
fun delay c = Susp c
fun force (Susp c) = c ()
let val x = Susp (fn () => horriblecomputation (234))
in (print ("test = " ^ Int.toString (force x + force x)^ "\n"))
end;
(*high order*)
fun remDuplicates lst =
case lst of
[] => []
| x::xs => let fun filter x' xs' =
case (x',xs') of
(x',[]) => []
|(x',xs' as y::ys) => if x' = y then filter y ys
else y::filter x ys
in x::remDuplicates(filter x xs)
end

Summation and Numerical Integration

fun sum (f,a,b) = if a>b then 0
else (f a) + sum (f,a+1,b)
fun sumSquares (a,b) = sum (fn x => x*x,a,b)
fun sum_b (f,a,b,inc) = if a>b then 0
else (f a) + sum_b (f,inc(a),b,inc)
fun sumOdd (a,b) = if (a mod 2) = 1 then
sum_b (fn x=>x, a, b, fn x=>x+2) else
sum_b (fn x=>x, a+1, b, fn x=> x+2)

Recursive Functions: Power, Factorial, Max, Append

fun pow (x,y) = if y=0 then 1 else x*pow(x,y-1)
fun factorial n = case n of 0 =>1
| _ => n*factorial (n-1)
fun max (pair:real*real) =
if (#1 pair) < (#2 pair) then (#2 pair)
else (#1 pair)
fun append (lst1,lst2)= case lst1 of [] => lst2
| x::xs => x::append(xs,lst2)
fun max lst :int option =
case lst of [] => NONE
| x::xs => let val y = max(xs) in
case y of NONE => SOME x
| SOME v => if x>v then SOME x
else SOME v
end

List Manipulation: Zip, Unzip, Merge, Mergesort

fun zip (x:int list , y:string list) : (int*string) list =
case (x,y) of
([],[]) => []
| (x::xs,[]) => []
| ([], y::ys) => []
|(x::xs,y::ys) => (x,y) :: zip (xs,ys)
fun unzip ( z:(int*string) list ) : int list * string list =
case z of
[] => ([],[])
|(x,y)::xys => let val (xs,ys) = unzip xys in (x::xs, y::ys)
end
fun merge (lst1,lst2) = case (lst1,lst2) of ([],lst2) => lst2
| (lst1,[]) => lst1
| (x::xs,y::ys) =>
case x<y of
true => x::(merge(xs,lst2))
| false => y::(merge(lst1,ys))
fun split (lst) =
case lst of [] => ([],[])
| [x] => ([x],[])
| x::y::xs => let val (p1,p2) = split xs in
(x::p1,y::p2) end
fun mergesort lst = case lst of [] =>[]
| [x] => [x]
| _ => let val (p1,p2) = split lst in
merge (mergesort p1, mergesort p2)
end

Church Numerals and Catalan Sequence

fun create (n:int) : 'a church =
case n of
0 => (fn (f,x) => x)
|_ => let val c = create (n-1) in
(fn (f,x) => f(c (f, x)))
end
fun churchToInt (c: int church) : int = c(fn x => x+1, 0)
fun succesor(c: 'a church) : 'a church = (fn (f,x) => f(c (f,x)))

Free Variables in Expressions

fun helper_rem (lst:string list ,elem:string) =
case lst of
[] => []
| x::xs => if (elem = x) then
helper_rem(xs,elem) else x::(helper_rem(xs,elem))
fun free_list (e : exp) : string list =
let fun free_list' (e' :exp) =
case e' of
Plus(a,b) => free_list'(a) @ free_list'(b)
| If(a,b,c) => free_list'(a) @ free_list'(b) @ free_list'(c)
| Var(a) => [a]
| Let(a,(x,b)) => helper_rem (free_list'(a)@free_list'(b),x)
| Fun(x,y,a) => helper_rem( helper_rem (free_list'(a), x),y)
in
free_list' (e)
end

Cells with Stack-Based State

datatype 'a instr = Put of 'a | Get | Restore
fun makeCell (x : 'a) : ('a instr -> 'a) =
let val stack = ref [x] in (* this cell is taking x already in the stack! *)
fn instruction => case instruction of
Put(n) => (stack := n :: (!stack); n)
| Get => hd(!stack)
| Restore => case !stack of
[] => (print "\n Nothing to Restore \n "; raise Error "Nothing to Restore")
| x::xs => (stack := xs; x)
end
val cell0 = makeCell 0;
fun sum (f:real->real, x:real, y:real, inc:real->real) =
if (x> y) then 0.0
else (f x) + sum (f, inc(x), y, inc)
fun integral (f:real->real) (g:real->real) (dy:real) (x:real) =
dy * sum ((fn y => f y * g (x + y)), 0.0 + dy/2.0 , x , (fn g => g+dy))

Catalan Sequence with Streams

fun helper_get_range (n:int) : int list =
case n of
0 => []
| _ => let fun cont x = if x < n then x::cont(x+1)
else [] in cont 0 end
fun Catalan (n : int) : int =
case n of
0 => 1
| _ => foldl (fn (n,cn) => fn 1 (helper_get_range n))
datatype realSeq = Cons of real * (unit -> realSeq)
fun take n s = case (n , s) of
(0, Cons (x, f)) => []
| (n, Cons (x, f)) => x :: (take (n-1) (f ()))
(*use Real.fromInt to avoid errors*)
fun helperSeq (n : int) : realSeq =
Cons (2.0 * (2.0 * Real.fromInt n + 1.0) / (Real.fromInt n+2.0) , fn () => helperSeq (n+1))
val catalanSeq : realSeq =
let fun stream n (Cons (coef,f)) =
let val n' = n * coef in
Cons (n', fn () => stream n' (f()))
end
in
Cons (1.0, fn () => stream 1.0 (helperSeq 0)) end