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 Cubesfun cube a = a*a*a fun sumCubes (a,b) = if (a>b) then 0 else cube (a) + sumCubes (a+1,b)
Tree Traversal and Filteringfun 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, Factorialfun 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 Programmingdatatype '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, Depthdatatype '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 Searchfun 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 Datadatatype '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 Numeralsfun 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 Exponentiationfun 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 Datatypesfun 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, Foldfun 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 Traversalexception 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 Accountsdatatype '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 Handlingdatatype '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 Integrationfun 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, Appendfun 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, Mergesortfun 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 Sequencefun 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 Expressionsfun 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 Statedatatype '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 Streamsfun 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
|