Some basic SML examples - McGill University
Some basic SML examples.
* Winter 2006 *)
(* Brigitte Pientka *)
(* Code for Lecture 1: Evaluation and Typing *)
(* Integers *)
~1 : int; (* NOT -1 *)
4 : int;
~3+2 : int;
5 div 2 : int;
(* Reals *)
3.14 : real;
5.0 / 2.0 : real; (* NOT 5 / 2 *)
(* Type errors
- 5 div 3.0;
stdIn:1.1-1.10 Error: operator and operand don't agree [literal]
operator domain: int * int
operand: int * real
in expression:
5 div 3.0
- 5.0 div 3;
stdIn:1.1-1.10 Error: operator and operand don't agree [literal]
operator domain: real * real
operand: real * int
in expression:
5.0 div 3
stdIn:1.5-1.8 Error: overloaded variable not defined at type
symbol: div
type: real
- 5/3;
stdIn:1.1-1.4 Error: operator and operand don't agree [literal]
operator domain: real * real
operand: int * int
in expression:
5 / 3
- 5.0 / 3;
stdIn:1.1-1.8 Error: operator and operand don't agree [literal]
operator domain: real * real
operand: real * int
in expression:
5.0 / 3
)
(* Booleans *)
true : bool;
false : bool;
if 0 = 0 then 1.0 else 2.0 : real;
if true then 4.0 else 1.0/0.0: real;
(* Type error
- if 0 = 0 then 1.0 else 5 ;
stdIn:1.1-1.25 Error: types of if branches do not agree [literal]
then branch: real
else branch: int
in expression:
if 0 = 0 then 1.0 else 5
*)
(* Typing and Evaluation *)
(* Some ill-typed expressions *)
(*
2.0 + 1;
if true then 1 else 2.0;
true + 0;
*)
(* Some well-typed expressions without a value *)
(*
1 div 0;
if 1 div 0 = 0 then true else false;
if false then 4 else 1 div 0;
*)
Simple recursive functions.
let val x = 1
in x + 2
end;
let val y = 3
in
let val x = (let val y = 2 in 2* y end)
in x + y
end
end;
(* If you use bigNums in Sml you can see the effect of these tail recursive
definitions. *)
fun tail_fact(n) =
let fun f(n,m) = (if (n = 0) then m else f(n-1,n*m))
in f(n,1)
end;
fun slow_fact(n) = if (n = 0) then 1 else n * slow_fact(n - 1)
fun tail_fib(n) =
let fun foo(n,a,b) = (if (n = 0) then a
else foo(n-1,a+b,a))
in foo(n,1,1) end;
fun slow_fib(n) =
if (n=0)
then
1
else
if (n=1)
then
1
else
slow_fib(n - 1) + slow_fib(n - 2)
fun even(n) = (n mod 2) = 0;
fun square(n) = n*n;
fun fastExp(base,power) = if (base = 0) then 0
else if (power = 0) then 1
else if even(power) then
fastExp(base*base,power div 2)
else base*fastExp(base, pow
# Simple list examples -- more than I did in class.
(* This runs in time O(n^2), where n is the length of the list. *)
fun dumbreverse(l) = if l = nil then nil else dumbreverse(tl(l)) @ [hd(l)]
(* This uses a helper function with an accumulating parameter. It runs in time
O(n) where n is the length of the list. We package the helper function inside
a let so that it is not exposed at the top level. *)
fun reverse(l) = let
fun helper (nil,a) = a
| helper (x::xs,a) = helper(xs,x::a)
in helper(l,nil) end
(* Here are recursive insert and insertion sort functions. Note the use of the
"as" construct in the definition of insert. Note that insert expects its
argument to be an integer and a sorted list. Of course isort does not expect
a sorted list. This will work well on lists of integers but not on
lists of strings or lists of reals. *)
fun insert(n,nil) = [n]
| insert(n,L as x::l) = if (n < x) then n::L else x::(insert(n,l));
fun isort(nil) = nil
| isort(x::l) = insert(x,isort(l));
(*This is a more generic insert function which takes a comparison function as
an argument and which then inserts accordingly. This works fine on strings:
ginsert("foo",["boo","moo","shoo"],fn (s:string,t) => (s < t));
val it = ["boo","foo","moo","shoo"] : string list
and on reals
ginsert(1.1,[1.0,1.2],fn (x:real,y) => x < y);
val it = [1.0,1.1,1.2] : real list
It uses a function (comp) as an argument, we will see this in greater detail
later. *)
fun ginsert(item, nil, comp) = item::nil
| ginsert(item, L as x::xs, comp) = if comp(item,x)
then item::L
else x::(ginsert(item,xs,comp))
(*This is a simple function to add the corresponding items in lists of
integers; the lists need not have equal length. Note there is no need
for a case with (nil,nil) as this is subsumed by the existing patterns.*)
fun addlists (nil,L) = L
| addlists (L,nil) = L
| addlists (x::xs,y::ys) = (x + y)::(addlists(xs,ys))
(* This function creates a list of lists; each list represents a row of
Pascal's triangle. The helper function has two accumulating parameters, the
first is the row just constructed, which is used to generate the next row,
and the second is the part of the triangle constructed so far. *)
fun pascal n =
let
fun helper(n,a,b) = if (n = 0) then b
else helper(n-1,addlists(0::a,a),b @ [a])
in
tl(helper(n+1,[1],[[1]]))
end
Concrete Datatype Examples from class, and more.
datatype colour = Red | White | Blue
fun mix (Red,White) = "pink"
| mix (Blue, White) = "pale blue"
| mix (Red, Blue) = "purple"
| mix (a,b) = mix (b,a)
(* Polymorphic binary trees. There is no ordering assumed. *)
datatype 'a tree =
Empty |
Node of 'a tree * 'a * 'a tree
val t1 = Node(Empty, 0, (Node(Empty, 1, Empty)));
val t2 = Node(Node(Empty,5,Empty),6,Empty);
val t3 = Node(Node(t2,2,Node(Empty,3,Empty)),4,t1);
fun max (n,m) = if n < m then m else n;
fun height Empty = 0
| height (Node (lft,_,rht)) = 1 + max(height lft, height rht);
fun sumNodes Empty = 0
| sumNodes (Node(l,n,r)) =
n + sumNodes(l) + sumNodes(r);
fun show n = print(Int.toString(n)^"\t");
fun inorder Empty = ""
| inorder (Node(l,n,r)) = inorder(l)^" "^(Int.toString(n))^" "^inorder(r);
fun preorder Empty = ""
| preorder (Node(l,n,r)) = (Int.toString(n))^" "^preorder(l)^" "^preorder(r);
(* We will study exceptions later. You can use them by imitation for now. *)
exception Empty_tree of string;
fun root Empty = raise Empty_tree ("Empty trees have no roots.")
| root (Node(l,n,r)) = n;
fun leftSubtree Empty = raise Empty_tree ("An empty tree has no left subtree.")
| leftSubtree (Node(l,_,_)) = l;
fun rightSubtree Empty = raise Empty_tree ("An empty tree has no right subtree.")
| rightSubtree (Node(_,_,r)) = r;
fun isEmpty Empty = true |
isEmpty _ = false;
fun depth(Empty,d) = nil
| depth(Node(l,n,r),d) = [(n,d)] @ depth(l,d+1) @ depth(r,d+1);
(* The following examples are specific to trees where the elements have an *)
(* order relation defined on them. We use integers for illustrative *)
(* purposes. Later we will see how to make this more polymorphic. *)
fun insert (n:int,Empty) = Node(Empty, n, Empty): int tree |
insert (n,Node(l,m,r): int tree) = if (n < m) then Node(insert(n,l), m, r)
else Node(l, m, insert(n,r));
val t4 = insert(7, Empty);
val t5 = insert(5,t4);
val t6 = insert(3,t5);
val t7 = insert(6,t6);
val t8 = insert(9,t7);
val t9 = insert(8,t8);
fun find(n, Empty) = false |
find(n, Node(l,m,r)) = if (m = n) then true
else if (n < m) then find(n,l)
else find(n,r);
(* Examples using expression trees. *)
datatype Exptree =
Leaf of int |
Add of Exptree * Exptree |
Mul of Exptree * Exptree;
val e1 = Mul(Leaf(3),Leaf(4));
val e2 = Add(Leaf(2),e1);
val e3 = Mul(e2, Leaf(7));
fun eval(Leaf n) = n
| eval(Mul (l,r)) = eval(l) * eval(r)
| eval(Add (l,r)) = eval(l) + eval(r);
fun printTree(Leaf(n)) = print(Int.toString(n))
| printTree(Add(e1,e2)) =
(
print("(+ ");
printTree(e1);
print(",");
printTree(e2);
print(")") )
| printTree(Mul(e1,e2)) =
(
print("(* ");
printTree(e1);
print(",");
printTree(e2);
print(")") );
(* The symbolic differentiation example. *)
datatype Mathexp =
Num of int
| Var of string
| Neg of Mathexp
| Add of Mathexp * Mathexp
| Mul of Mathexp * Mathexp
| Power of Mathexp * int
| Sin of Mathexp
| Cos of Mathexp
| Exp of Mathexp
fun diff (Num n, x:string) = Num 0
| diff (Var s, x) = if ( s = x) then Num 1 else Num 0
| diff (Neg e, x) = Neg (diff(e,x))
| diff (Add(e1,e2),x) = Add(diff(e1,x),diff(e2,x))
| diff (Mul(e1,e2),x) = Add(Mul(diff(e1,x),e2),Mul(e1,diff(e2,x)))
| diff (Power(e,n),x) = Mul(Mul(Num n, Power(e,n-1)),diff(e,x))
| diff (Sin(e),x) = Mul(Cos(e), diff(e,x))
| diff (Cos(e),x) = Neg(Mul(Sin(e), diff(e,x)))
| diff (Exp(e),x) = Mul(Exp(e), diff(e,x))
val me = Exp(Power(Var("x"),3))
val me2 = Mul(Sin(Var("x")),Cos(Mul(Var("x"),Var("y"))))
# Higher order functions I; 27th Sept.
fun sumints(a,b) = if (a > b) then 0 else a + sumints(a+1,b)
fun cube n = n*n*n
fun sumcubes(a,b) = if (a > b) then 0 else cube(a) + sumcubes(a+1,b)
(* Gregory's formula for pi/8, it works very poorly. It took 10,000 terms
to get 3 decimal places! *)
fun piterm x = 1.0/(Real.fromInt(x) * (Real.fromInt(x)+2.0))
fun pisum(a,b) = if (a > b) then 0.0 else piterm(a) + pisum(a+4,b)
(* We abstract these to get the general procedure below. Note that because of
the type mismatch it cannot do pisum. *)
fun sum(term,lo,hi,inc) =
if (lo > hi) then 0
else ((term(lo)) + sum(term,inc(lo),hi,inc))
(* Now sumcubes can be defined as below. The others are similar. *)
fun sum_cubes(lo,hi) = sum(cube,lo,hi,fn x => (x+1))
(* Product in analogy with sum. *)
fun product(term,lo,hi,inc) =
if (lo > hi) then 1
else term(lo) * product(term,inc(lo),hi,inc)
(* Using product to define factorial. *)
fun factorial n = product(fn x => x, 1, n, fn x => (x + 1))
(* The general accumulator written in the tail-recursive form. *)
fun accumulate(combiner,term,lo,hi,inc,result) =
if (lo > hi) then result
else
accumulate(combiner,term,inc(lo),hi,inc,combiner(result,term(lo)))
(* An iterative version of sum modified to deal with real values. *)
fun iter_sum(term,lo:real,hi,inc,result:real) =
if (lo > hi) then result
else iter_sum(term,inc(lo),hi,inc,(result + term(lo)))
(* The following is for testing the integrator. Make sure that you put
parentheses around declarations like x:real. *)
fun rcube(x:real) = x*x*x
fun integral(f,lo,hi,dx) =
dx * iter_sum(f,(lo + (dx / 2.0)), hi, fn x => (x + dx),0.0)
fun abs(x:real) = if (x < 0.0) then ~x else x
(* Never ever try to test whether two reals are equal. *)
fun close(x:real,y:real) = (abs(x - y) < 0.001)
(* The following works with what are called "contractive functions" and
not with any continuous functions. *)
fun fixed_point(f,init:real) =
if (close(f(init),init)) then init
else fixed_point(f,f(init))
(* Try it with the functions below. *)
fun mysin(x:real) = Real.Math.sin(x)
fun mycos(x:real) = Real.Math.cos(x)
(* Learn how to abort the computation before trying the one below! *)
fun myexp(x:real) = Real.Math.exp(x)
Higher order functions II; 29th Sept.
fun foo x = Real.Math.sin(x)
fun abs(x:real) = if (x < 0.0) then ~x else x
fun close(x:real,y:real,tol:real) = (abs(x-y) < tol)
fun square(x:real) = x*x
fun halfint(f,pos_value:real,neg_value:real,epsilon:real) =
let
val mid = (pos_value + neg_value)/2.0
in
if (abs(f(mid)) < epsilon)
then mid
else
if (f(mid) < 0.0)
then halfint(f,pos_value,mid,epsilon)
else halfint(f,mid,neg_value,epsilon)
end
fun simpleMap(f,[]) = []
| simpleMap(f,x::xs) = f(x)::(simpleMap(f,xs))
exception EmptyList
fun myreduce(f,[]) = raise EmptyList
| myreduce(f,[a]) = a
| myreduce(f,x::xs) = f(x,myreduce(f,xs))
fun plus(x:real,y:real) = x + y
fun variance(liszt) =
let
val n = real(length(liszt))
in
myreduce(plus,simpleMap(square,liszt))/n
- square(myreduce(plus, liszt)/n)
end
fun filter(cond,[]) = []
| filter(cond,x::xs) = if cond(x) then x::(filter(cond,xs))
else filter(cond,xs)
fun odd(n) = (n mod 2) = 1
filter(odd,[1,2,5,3,4,6,7,7,4]);
fun deriv (f, dx:real) = fn x => ((f(x + dx) - f(x))/dx)
fun compose(f,g) = fn x => g(f(x))
fun inc1 n = n + 1
fun mul2 n = n * 2
fun plus1(x,y) = x + y
fun plus2 x y = x + y
References; 2nd October.
(* Code from Harper's Notes. *)
val r = ref 0
val s = ref 0
val a = r=s
val _ = r := 3
val x = !s + !r
val t = r
val b = s=t
val c = r=t
val _ = t := 5
val y = !s + !r
val z = !t + !r
fun rot3 (a, b, c) =
let
val t = !a
in
a := !b; b := !c; c := t
end
fun rot3 (a, b, c) =
let
val (x, y, z) = (!a, !b, !c)
in
a := y; b := z; c := x
end
fun rot3 (a, b, c) =
let
val (ref x, ref y, ref z) = (a, b, c)
in
a := y; b := z; c := x
end
(* An imperative version of factorial. *)
fun imperative_fact (n:int) =
let
val result = ref 1
val i = ref 0
fun loop () =
if !i = n then
()
else
(i := !i + 1; result := !result * !i; loop ())
in
loop (); !result
end
(* Bob Harper's code for a cached version of the Catalan program. *)
fun C 1 = 1
| C n = sum (fn k => (C k) * (C (n-k))) (n-1)
local
val limit : int = 100
val memopad : int option array = Array.array (limit, NONE)
in
fun C' 1 = 1
| C' n = sum (fn k => (C k) * (C (n-k))) (n-1)
and C n =
if n < limit then
case Array.sub (memopad, n)
of SOME r => r
| NONE =>
let
val r = C' n
in
Array.update (memopad, n, SOME r);
r
end
else
C' n
end
(* Prakash's code with some fixes by Brigitte. *)
fun fastexp(b,e) =
let
val r = ref 1
val i = ref e
val j = ref b
fun loop () =
if !i = 0 then ()
else
if ((!i mod 2) = 0) then
(j := !j * !j; i := !i div 2; loop())
else
(r := !j * !r; i := !i - 1; loop())
in
loop(); !r
end
(* Code for Reference Lists. *)
datatype 'a rlist = Empty | RCons of 'a * (('a rlist) ref)
(* Sometimes you want the tail as a reference, then use tail;
sometimes you want the actual value, then use cdr .*)
fun cdr(RCons(_,t)) = !t
fun tail(RCons(_,t)) = t
(* This is an imperative append function. Its type is
val it = fn : ''a rlist * ''a rlist -> ''a rlist.*)
fun rappend2 (Empty, r) = r
| rappend2 (f as RCons(h, t), r) =
if (!t = Empty) then
((t := r);f)
else
(t := rappend2(!t, r); f)
(* Test case:
- rappend2 (RCons(1, ref (RCons(2, ref Empty))), RCons(5, ref Empty));
val it = RCons (1,ref (RCons (2,ref (RCons (5,ref Empty))))) : int rlist
*)
(* This is an in place reverse function. It uses a cursor to keep track of
where it is in the original list and a temp to hold onto that position while
the cursor is being advanced. Note the use of tail and cdr as appropriate. *)
fun reverse r =
let
val result = ref Empty
val temp = ref Empty
val cursor = ref r
in
(while (not (!cursor = Empty)) do
(temp := !cursor;
cursor := cdr(!cursor);
tail(!temp) := !result;
result := !temp);
!result)
end
(*
Demonstration of in-place reverse in action. Note how the original list
is destroyed.
- val foo = RCons (1,ref (RCons (2,ref (RCons (5,ref Empty)))));
val foo = RCons (1,ref (RCons (2,ref (RCons (5,ref Empty))))) : int rlist
val reverse = fn : ''a rlist -> ''a rlist
val it = () : unit
- val moo = reverse foo;
val moo = RCons (5,ref (RCons (2,ref (RCons (1,ref Empty))))) : int rlist
- moo;
val it = RCons (5,ref (RCons (2,ref (RCons (1,ref Empty))))) : int rlist
- foo;
val it = RCons (1,ref Empty) : int rlist
*)
Objects as Closures in Sml 6th October.
(* The simplest example showing how local state is captured. *)
val a = ref 0;
fun flip1() = (print("flip\t"); (a := 1 - (!a)); print(Int.toString(!a)^"\n"));
(* The following does not work at all because each time flip2 is called
a new local variable is called and initialized. When the call is over
the local variable is removed. *)
fun flip2() = let val a = ref 0 in
(print("flip\t"); (a := 1 - (!a)); print(Int.toString(!a)^"\n")) end;
(* This makes flip objects. *)
fun makeflipper() =
let
val a = ref 0
in
fn () =>
(print("flip\t"); (a := 1 - (!a)); print(Int.toString(!a)^"\n"))
end
(* two independent flippers. *)
val flip3 = makeflipper ()
val flip4 = makeflipper ()
(* Demo of the flippers.
val flip3 = makeflipper ();
val flip3 = fn : unit -> unit
- flip3 ();
flip 1
val it = () : unit
- flip3 ();
flip 0
val it = () : unit
- val flip4 = makeflipper();
val flip4 = fn : unit -> unit
- flip3 ();
flip 1
val it = () : unit
- flip4 ();
flip 1
val it = () : unit
*)
(* A bank account object with a local variable balance.*)
val withdraw =
let val balance = ref 100
in
fn amount => if (amount < !balance)
then (balance := !balance - amount; !balance)
else (print("Insufficient funds\n");!balance)
end
fun makeWithdraw openingBalance =
let val balance = ref openingBalance
in
fn amount => if (amount < !balance)
then (balance := !balance - amount; !balance)
else (print("Insufficient funds\n");!balance)
end
(* Demo of makeWithdraw showing two independent account with seperate
balance values coexisting.
val prakashAccount = makeWithdraw 1500;
val prakashAccount = fn : int -> int
- val janeaccount = makeWithdraw 100;
val janeaccount = fn : int -> int
- prakashAccount 625;
val it = 875 : int
- janeaccount 50;
val it = 50 : int
- prakashAccount 35;
val it = 840 : int
- janeaccount 27;
val it = 23 : int
*)
(* Datatype of bank account transactions.*)
datatype transactions =
Withdraw of int | Deposit of int | Check_balance
(* Bank account generator. *)
fun make_account(opening_balance:int) =
let
val balance = ref opening_balance
in
fn (Withdraw(x)) => (balance := !balance - x; !balance)
| (Deposit(x)) => (balance := !balance + x; !balance)
| Check_balance => !balance
end
(* Demo of accounts showing two independent accounts with their own
local balance variables being altered independently.
val pAccount = make_account(500);
val pAccount = fn : transactions -> int
- val mAccount = make_account(700);
val mAccount = fn : transactions -> int
- pAccount(Withdraw(177));
val it = 323 : int
- mAccount(Deposit(259));
val it = 959 : int
- pAccount(Deposit(67));
val it = 390 : int
- mAccount(Withdraw(47));
val it = 912 : int
*)
(* Bank account objects as a record structure. *)
fun make_account(opening_balance:int) =
let
val balance = ref opening_balance
in
{ Check_balance = fn () => !balance,
Deposit = fn x => (balance := !balance + x; !balance),
Withdraw = fn x => (balance := !balance - x; !balance)}
end
(*
val make_account = fn
: int
-> {Check_balance:unit -> int, Deposit:int -> int, Withdraw:int -> int}
val it = () : unit
- val janet_account = make_account 100000;
val janet_account = {Check_balance=fn,Deposit=fn,Withdraw=fn}
: {Check_balance:unit -> int, Deposit:int -> int, Withdraw:int -> int}
- val wayne_account = make_account 1000000;
val wayne_account = {Check_balance=fn,Deposit=fn,Withdraw=fn}
: {Check_balance:unit -> int, Deposit:int -> int, Withdraw:int -> int}
- val rick_account = make_account 10000000;
val rick_account = {Check_balance=fn,Deposit=fn,Withdraw=fn}
: {Check_balance:unit -> int, Deposit:int -> int, Withdraw:int -> int}
- #Deposit janet_account 5000;
val it = 105000 : int
- #Check_balance janet_account ();
val it = 105000 : int
- val {Withdraw = wayne_withdraw, Deposit = _, Check_balance = _} =
wayne_account;
val wayne_withdraw = fn : int -> int
- wayne_withdraw(50000);
val it = 950000 : int
- #Check_balance wayne-account;
stdIn:11.22-11.29 Error: unbound variable or constructor: account
stdIn:11.16-11.21 Error: unbound variable or constructor: wayne
- #Check_balance wayne_account;
val it = fn : unit -> int
- #Check_balance wayne_account ();
val it = 950000 : int
*)
Exceptions; 10th October.
type key = int
datatype 'a btree = Empty | Node of 'a btree * (key * 'a) * 'a btree
fun insert (n,Empty) = Node(Empty, n, Empty)
| insert (n as (k:key,v),Node(l,n1 as (k1,v1),r)) =
if (k < k1)
then
Node(insert(n,l), n1, r)
else
Node(l, n1, insert(n,r));
val t1 = insert((10,"Macbeth"),Empty)
val t2 = insert((5,"MacDuff"),t1)
val t3 = insert((2,"Banquo"),t2)
val t4 = insert((17,"Duncan"),t3)
val t5 = insert((13,"Hecate"),t4)
val t6 = insert((15,"Donalbain"),t5)
val t7 = insert((16,"Sinel"),t6)
(* Find with option type
findOpt : 'a btree * int -> 'a opt *)
fun findOpt (Empty, k) = NONE
| findOpt (Node(L, (k',d), R), k) =
if k = k' then SOME(d)
else
(if k < k' then findOpt(L, k) else findOpt(R, k))
(* Find (T,k) = d if (k,d) is in the tree T
raises exception notFound otherwise *)
exception NotFound
fun find (Empty, k) = raise NotFound
| find (Node(L, (k',d), R), k) =
if k = k' then d
else
(if k < k' then find(L, k) else find(R, k))
(* Find (T,k) = d
raises exception Found(d) if (k,d) is in the tree T
raises exception notFound otherwise
NOTE: Usually the excessive use of exception is bad...
This example just illustrates we can use exceptions
to also propagate values.
*)
exception Found of string
fun findEx (Empty, k) = raise NotFound
| findEx (Node(L, (k',d), R), k) =
if k = k' then raise Found(d)
else
(if k < k' then findEx(L, k) else findEx(R, k))
(* Some top level functions which illustrate how to
handle exceptions; we contrast it with how one handles
optional values. *)
fun findOpt_top (T,k) =
case findOpt(T,k) of
NONE => print ("Found no element with key " ^ Int.toString k ^ " in tree \n")
| SOME(d) => print ("Found element " ^ Int.toString d ^ " in tree \n")
(* Handling exceptions:
exp handle match is an exception handler.
It attempts to evaluate exp. If this yields a value, then this
value is returned. If evaluation of exp raises an exception exc
then exc is matched against match to determine how to proceed.
if there is no handler or no successful match, the exception
will re-raised and propagated to the next higher level.
If it is never caught at any higher level, the computation will
abort with an uncaugt exception exc
*)
fun find_top (T, k) =
(let
val d = find(T,k) (* the exception raised by find(T,k) will propel you
to the next higher level! -- nothing below this line
in particular the statement print "Found element ..."
will not be executed *)
in
print ("Found element " ^ d ^ " in tree \n")
end) handle NotFound => print ("Found no element with key " ^ Int.toString k ^ " in tree \n")
(* we can also dispatch on the different exceptions *)
fun find_top' (T, k) =
findEx(T,k)
handle Found(d) => print ("Found element " ^ d ^ " in tree \n")
| NotFound => print ("Found no element with key " ^ Int.toString k ^ " in tree \n")
(* Exceptions are propogated to the next level, if
they are not caught!
*)
fun find_uncaught(T,k) = find(T,k)
fun find_catch(T,k) =
(let
val d = find_uncaught(find(T,k))
in
print ("Found element " ^ Int.toString d ^ " in tree \n")
end) handle NotFound => print ("Found no element with key " ^ Int.toString k ^ " in tree \n")
(* The primary benefit of exceptions:
1 The force you to consider the exceptional case.
2 They allow you to segregate the specail case
from the normal case in the code.
(often avoids clutter)
*)
(* Use of exceptions to initiate backtracking *)
(* Making change with given coins
[5,2] means we have an infinite number of 5 and 2 coins.
- change [50, 25, 10, 5, 2, 1] 43;
val it = [25,10,5,2,1] : int list
- change [50, 25, 10, 5, 2, 1] 13;
val it = [10,2,1] : int list
- change [5, 2, 1] 13;
val it = [5,5,2,1] : int list
The idea is to proceed greedily, but if we get stuck,
we undo the most recent greedy decision and proceed again from there.
*)
(* First some toString conversion function *)
fun listToString nil = ""
| listToString (l as h::t) =
let
fun toString (h::nil) = Int.toString h
| toString (h::t) = Int.toString h ^ ", " ^ toString t
in
toString l
end
exception Change
fun change _ 0 = nil
| change nil _ = raise Change
| change (coin::coins) amt =
(if coin > amt then
change coins amt
else
(coin :: change (coin::coins) (amt - coin)))
handle Change => change coins amt
fun change_top coins amt =
(let
val C = change coins amt
in
print ("Return the following change: " ^ listToString C ^ "\n")
end
) handle Change => print ("Sorry, I cannot give change\n")
(* Here is the behavior of change_top :
- change_top [2,5] 3;
Sorry, I cannot give change
val it = () : unit
- change_top [2,5] 8;
Return the following change: 2, 2, 2, 2
val it = () : unit
- change_top [5, 2] 8;
Return the following change: 2, 2, 2, 2
val it = () : unit
- change_top [25, 10, 5, 2] 43;
Return the following change: 25, 10, 2, 2, 2, 2
val it = () : unit
- change_top [25, 10, 5, 2] 44;
Return the following change: 25, 10, 5, 2, 2
val it = () : unit
- change_top [25, 10, 2] 44;
Return the following change: 10, 10, 10, 10, 2, 2
val it = () : unit
- change_top [25, 10, 2] 43;
Return the following change: 25, 10, 2, 2, 2, 2
val it = () : unit
- change_top [25, 10, 2] 23;
Sorry, I cannot give change
val it = () : unit
*)
The Interpreter
(* ML code for an interpreter for a simple lambda-calculus based language.
** The evaluation strategy is call by value. Substitution is handled by an
** environment mechanism. Static binding is enforced by using closures.
** The evaluator takes terms of the datatype "lterm" and returns results of
** type "results". Plus is provided as a primitive operation. The
** environment is structured as a layered list, each layer representing a new
** scope. Each layer is essentially a list of (variable, result) pairs.
** The types "results", "layer" and "envs" are defined by mutual
** recursion. A Let expression has a list of (variable, expression) pairs
** to represent the new declarations, and also a body as its second component.
*)
datatype lterm =
NUM of int |
VAR of string |
APPLY of lterm *lterm |
PLUS of lterm *lterm |
LAMBDA of lterm * lterm |
LET of (( string * lterm) list) *lterm;
datatype
results =
INT of int |
CLOSURE of (lterm * envs)|
UNBOUND
and
layer =
LAYER of (lterm * results) list
and
envs =
ENV of layer list;
(* The following exceptions are used to catch improper arguments. The
** exception handling mechanism is not being used. This just illustrates the
** definition of exceptions and their use in programs.
*)
exception Improper_binding of string;
exception Improper_add;
exception Non_lambda;
exception Non_closure;
(* The following functions are utilities to search through and to build up
** environments and closures.
*)
fun first_part ((x,y)) = x;
fun sec_part ((x,y)) = y;
fun toplayer(ENV env) = (hd (env));
fun firstpair(LAYER layer) = hd (layer);
(* The next function searches for a variable in a layer. Search_layer
** exists only to strip off the constructor and then call bound_in which
** searches a list. Search_env and binding interact analogously.
*)
fun bound_in ([],(VAR n)) = (false, UNBOUND)
| bound_in ((x,y)::rest,(VAR n)) =
(if x = (VAR n) then (true, y)
else bound_in (rest,(VAR n)))
| bound_in (_,_) = raise Improper_binding ("Searching for non-variable");
fun search_layer (VAR x , LAYER l)= bound_in (l, VAR x) |
search_layer (_, LAYER l) = raise Improper_binding ("Searching for non-variable");
fun binding ([], (VAR n)) = UNBOUND
| binding (x::rest, VAR n) =
let val (p,q) = search_layer(VAR n, x) in
if p then q else binding(rest, VAR n) end
| binding (_,_) = raise Improper_binding ("Searching for non-variable");
fun newenv (x, ENV n) = ENV ((LAYER x)::n);
fun search_env (ENV n, VAR x) = binding (n, VAR x) |
search_env (ENV n, _) = raise Improper_binding ("Searching for non-variable");
(* The following functions build closures and take them apart. *)
fun lambda_body (LAMBDA (x,y)) = y |
lambda_body (_) = raise Non_lambda;
fun boundvar (LAMBDA (x,y)) = x |
boundvar (_) = raise Non_lambda;
fun make_closure (LAMBDA n, ENV x) = CLOSURE (LAMBDA n ,ENV x) |
make_closure (_, ENV x) = raise Non_lambda;
fun get_body (CLOSURE (exp, env))= lambda_body exp |
get_body (_) = raise Non_closure;
fun get_var (CLOSURE (exp, env))= boundvar exp |
get_var (_) = raise Non_closure;
fun get_env (CLOSURE (exp, env)) = env |
get_env (_) = raise Non_closure;
(* The following implements the primitive arithmetic operation in terms of
** ML's built-in arithmetic.
*)
fun add (INT x, INT y) = INT (x+y)
| add (_,_) = raise Improper_add;
(* The following three functions are defined mutually recursively.
** Make_new_layer makes a new layer from a list of (variable, expression)
** declarations. It needs to call the evaluator to evaluate the expressions
** so that the layer being constructed has (variable, result) pairs in it.
** Apply expects a closure and an evaluated argument. It recursively calls
** eval on the body once the new binding has been established.
*)
fun make_new_layer ([], env) = [] |
make_new_layer ((var, expr)::rest, env) =
(VAR var, eval(expr, env))::make_new_layer(rest, env)
and
apply(closure, arg) = eval((get_body(closure)),
(newenv([((get_var closure), arg)],
(get_env closure))))
and
eval (VAR x, env) = search_env (env, VAR x)
| eval (NUM y,env) = INT y
| eval (PLUS (exp),env) = add(eval (first_part(exp),env),
eval(sec_part(exp),env))
| eval (LAMBDA exp,env:envs) = make_closure (LAMBDA (exp) , env)
| eval (APPLY (func, arg) ,env) =
apply(eval(func, env), eval(arg, env))
| eval (LET (binding_list, let_body),env) =
eval (let_body,
newenv((make_new_layer(binding_list, env),env)));
SCHEME
Equal
(define a 1)
;Value: a
(define b 1)
;Value: b
(equal? a b)
;Value: #t
(equal? 'a 'b)
;Value: ()
(eq? a b)
;Value: #t
(define p (cons 1 '()))
;Value: p
(define q (cons 1 '()))
;Value: q
(equal? p q)
;Value: #t
(eq? p q)
;Value: ()
''foo
;Value 1: (quote foo)
(car ''foo)
;Value: quote
Trees
(define (root tree) (car tree))
(define (left tree) (cadr tree))
(define (right tree) (caddr tree))
(define (make-tree root left right) (list root left right))
(define (intree? n arbre)
(cond ((null? arbre) '())
((= n (root arbre)) #t)
((< n (root arbre)) (intree? n (left arbre)))
((> n (root arbre)) (intree? n (right arbre)))))
;Value: intree?
(define (key-of record) (car record))
(define (item-of record) (cadr record))
(define (lookup key t)
(if (null? t)
(begin (newline) (write "Not found."))
(let ((k (key-of (root t)))
(i (item-of (root t))))
(cond ((= key k) i)
((< key k) (lookup key (left t)))
(else (lookup key (right t)))))))
;Value: lookup
(define (insert rec tr)
(if (null? tr)
(list rec '() '())
(let ((kr (key-of rec))
(kt (key-of (root tr))))
(cond ((= kr kt)
(begin (newline)
(write "Inserting duplicate.")
(make-tree (root tr) (insert rec (left tr)) (right tr))))
((< kr kt)
(make-tree (root tr) (insert rec (left tr)) (right tr)))
(else (make-tree (root tr) (left tr) (insert rec (right tr))))))))
;Value: insert
(define t1 '())
(define t2 (insert '(15 "Dwalin") t1))
(define t3 (insert '(10 "Balin") t2))
(define t4 (insert '(25 "Thorin") t3))
(define t5 (insert '(18 "Fili") t4))
(define t6 (insert '(21 "Kili") t5))
(define t7 (insert '(23 "Oin") t6))
(define t8 (insert '(13 "Bombur") t7))
(lookup 18 t8)
Lambda
; Boolean selectors as lambda terms.
(define (true x y) x)
(define (false x y) y)
; Pairs as lambda terms.
(define (pair x y) (lambda (z) (z x y)))
(define (fst p) (p (lambda (x y) x)))
(define (snd p) (p (lambda (x y) y)))
; Code for Church numerals.
(define (display n)
((n (lambda (x) (+ x 1))) 0))
;Value: display
(define one (lambda (f) (lambda (x) (f x))))
;Value: one
(define two (lambda (f) (lambda (x) (f (f x)))))
;Value: two
(display two)
;Value: 2
(define (sum h g)
(lambda (f)
(lambda (x)
((h f) ((g f) x)))))
;Value: sum
(display (sum one two))
;Value: 3
(display (sum (sum (sum two two) one) two))
;Value: 7
(define (times h g)
(lambda (f)
(lambda (x)
((h (g f)) x))))
;Value: times
(define three (lambda (f) (lambda (x) (f (f (f x))))))
;Value: three
(display (times three two))
;Value: 6
(define (exp n m) (lambda (f) (lambda (x) (((n m) f) x))))
;Value: exp
(display (exp three two))
;Value: 8
(display (exp two three))
;Value: 9
Cons-stream
; Basic stream primtives & procedures
(define-syntax cons-stream
(syntax-rules ()
((cons-stream x y)
(cons x (delay y)))))
(define the-empty-stream '())
(define stream-null? null?)
(define empty-stream? stream-null?)
(define stream-car car)
(define head stream-car)
(define (stream-cdr s) (force (cdr s)))
(define tail stream-cdr)
(define (stream-map proc s)
(if (empty-stream? s)
the-empty-stream
(cons-stream (proc (head s))
(stream-map proc (tail s)))))
; A very basic infinite stream, notice the recursive definition.
(define ones (cons-stream 1 ones))
; This is what you see when you try to display "ones."
ones
;Value: (1 . #[promise 2])
; An infinite stream that is not just a repeating (circular) list
(define (nums-from n) (cons-stream n (nums-from (+ n 1))))
(define naturals (nums-from 1))
;; Some basic stream operations, using recursion.
; Select the n-th element of a stream, assumes that the stream is infinite.
(define (nth-stream n s)
(if (= n 0)
(head s)
(nth-stream (- n 1) (tail s))))
(define (myfilter pred str)
(cond ((empty-stream? str) the-empty-stream)
((pred (head str))
(cons-stream (head str)
(myfilter pred (tail str))))
(else (myfilter pred (tail str)))))
; I keep forgetting whether it is called "map-stream or "stream-map"!
(define (map-stream proc str)
(stream-map proc str))
(define (remove item str)
(filter (lambda (x) (not (equal? x item)))
str))
;; A utility function to allow you to see a prefix of a stream.
;; It converts the first n elements of the stream s into a list.
(define (prefix n s)
(if (= n 0)
()
(cons (head s)
(prefix (- n 1)
(tail s)))))
;; How to add two infinite streams element by element
(define (add-streams s1 s2)
(cons-stream (+ (head s1) (head s2))
(add-streams (tail s1) (tail s2))))
;Value: add-streams
; The partial sums of an infinite stream of numbers.
(define (psums s)
(cons-stream (head s)
(add-streams (tail s) (psums s))))
;Value: psums
; Another way of getting all the positive ints
(define ints (psums ones))
;Value: ints
(prefix 10 ints)
;Value: (1 2 3 4 5 6 7 8 9 10)
; The triangular numbers.
(define triangular (psums ints))
;Value: triangular
(prefix 20 triangular)
;Value: (1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210)
(prefix 10 (psums triangular))
;Value: (1 4 10 20 35 56 84 120 165 220)
; Pascal's triangle, a stream of streams, each of the inner streams
; is an (infinite) sequence parallel to one of the sides of Pascal's triangle.
(define pascal (cons-stream ones (map-stream psums pascal)))
;Value: pascal
(prefix 10 (nth-stream 7 pascal))
;Value: (1 8 36 120 330 792 1716 3432 6435 11440)
; A useful function to be used to find ALL the primes.
(define (divisible? x y)
(= (remainder x y) 0))
; The sieve of Erasthosthenes
(define (sieve str)
(cons-stream
(head str)
(sieve (myfilter
(lambda (x) (not (divisible? x (head str))))
(tail str)))))
;; ALL the primes in one list.
(define primes (sieve (nums-from 2)))
; (%exit)
; Moriturus te saluto.
(define (show-nth n s) (if (= n 1) (head s) (show-nth (- n 1) (tail s))))
;; An extended example Ramanujan's numbers. The numbers that can be
;; expressed as the sum of two cubes in two different ways. For example
;; 1729 is 10^3 + 9^3 and also 12^3 + 1^3. This is the smallest such
;; number. (It also happens to be a Carmichael number but that is another
;; story!)
(define (merge-wt s1 s2 f)
(let ((h1 (head s1)) (h2 (head s2)))
(if ( (length (cdr l)) 1)) rawram))
More Lambda
There are several possible ways to define the natural numbers in lambda calculus, but by far the most common are the Church numerals, which can be defined as follows:
0 := λ f x. x
1 := λ f x. f x
2 := λ f x. f (f x)
3 := λ f x. f (f (f x))
and so on. Intuitively, the number n in lambda calculus is a function that takes a function f as argument and returns the n-th composition of f. That is to say, a Church numeral is a higher-order function -- it takes a single-argument function f, and returns another single-argument function.
(Note that in Church's original lambda calculus, the formal parameter of a lambda expression was required to occur at least once in the function body, which made the above definition of 0 impossible.) Given this definition of the Church numerals, we can define a successor function, which takes a number n and returns n + 1:
SUCC := λ n f x. f (n f x)
Addition is defined as follows:
PLUS := λ m n f x. m f (n f x)
PLUS can be thought of as a function taking two natural numbers as arguments and returning a natural number; it is fun to verify that
PLUS 2 3 and 5
are equivalent lambda expressions. Multiplication can then be defined as
MULT := λ m n. m (PLUS n) 0,
the idea being that multiplying m and n is the same as m times adding n to zero. Alternatively
MULT := λ m n f. m (n f)
The predecessor PRED n = n - 1 of a positive integer n is more difficult:
PRED := λ n f x. n (λ g h. h (g f)) (λ u. x) (λ u. u)
or alternatively
PRED := λ n. n (λ g k. (g 1) (λ u. PLUS (g k) 1) k) (λ v. 0) 0
Note the trick (g 1) (λ u. PLUS (g k) 1) k which evaluates to k if g(1) is zero and to g(k) + 1 otherwise.
Logic and predicates
By convention, the following two definitions (known as Church booleans) are used for the boolean values TRUE and FALSE:
TRUE := λ x y. x
FALSE := λ x y. y
(Note that FALSE is equivalent to the Church numeral zero defined above)
Then, with these two λ-terms, we can define some logic operators:
AND := λ p q. p q FALSE
OR := λ p q. p TRUE q
NOT := λ p. p FALSE TRUE
IFTHENELSE := λ p x y. p x y
We are now able to compute some logic functions, as for example:
AND TRUE FALSE
≡ (λ p q. p q FALSE) TRUE FALSE →β TRUE FALSE FALSE
≡ (λ x y. x) FALSE FALSE →β FALSE
and we see that AND TRUE FALSE is equivalent to FALSE.
A predicate is a function which returns a boolean value. The most fundamental predicate is ISZERO which returns TRUE if its argument is the Church numeral 0, and FALSE if its argument is any other Church numeral:
ISZERO := λ n. n (λ x. FALSE) TRUE
The availability of predicates and the above definition of TRUE and FALSE make it convenient to write "if-then-else" statements in lambda calculus.
Pairs
A pair (2-tuple) datatype can be defined in terms of TRUE and FALSE.
CONS := λf.λs. λb. b f s
CAR := λp. p TRUE
CDR := λp. p FALSE
A linked list datatype can be defined as either a reserved value (e.g. FALSE) for the empty list, or the CONS of an element and a smaller list.
HOMEWORKS
2)
(* Question 1. 20 points. Implement a function remDup:'a list -> 'a list which when
given a list, returns a list where all duplicates have been removed, i.e. every element occurs
only once. *)
fun remDup ([]) = []
| remDup (x::xs) =
let fun remX(x, []) = [] (* auxiliary function removes element x from list l *)
| remX(x,l::ls) =
if x = l
then remX(x,ls)
else l::remX(x,ls)
in
x::remDup(remX(x,xs))
end;
(* Question 2.
Implement a function newton: (real -> real) * real * real -> real, which when
given a function f, a guess x0 and a tolerance t, will compute a value x0 s.t. |f(x0)| < t.
*)
(* auxiliary functions *)
fun deriv(f, dx) = fn x => (f(x+0.5*dx)-f(x-0.5*dx))/(dx); (* this is actually better than (f(x+h) - f(x))/h for most cases *)
fun abs(x:real) = if (x < 0.0) then ~x else x;
fun close(x:real,y:real,tol) = (abs(x-y) < tol);
exception DivZero;
exception Diverge;
val (STEPS,DX) = (10000,0.0000001); (* defining some nice constants for newton calcs *)
(* main newton function *)
fun newton(f,x0,t) =
let fun newtondiv (f,x0,t,i)= (* this function is basicly newton again with added iteration step check *)
if close(f(x0),0.0,t) (* base case *)
then x0
else if i = 0 (* divergence case *)
then raise Diverge
else let val r = f(x0)/deriv(f,DX)(x0) (* i choose dx relative to the tolerance *)
in if Real.isFinite(r) (* df/dx = 0 -> divide by zero case -> f(x0)/0 is not a finite number*)
then newtondiv(f,x0-r,t,i-1) (* recursion step *)
else raise DivZero
end
in newtondiv(f,x0,t,STEPS)
end;
(* Question3.
20 points. Suppose we have defined a datatype for binary trees using the
following definition: *)
datatype 'a tree =
Empty |
Node of 'a tree * 'a * 'a tree;
(* Implement a function , flatten:?a tree -> ?a list which given a binary tree, will
return a list of all the elements in the tree in preorder. *)
fun flatten Empty = []
| flatten (tree) =
let fun postacc(Empty,List) = List
| postacc(Node(left,e,right),List) =
e::postacc(left,postacc(right,List))
in postacc(tree,[])
end;
3)
(* 1)
Insert in ref list. Datatype: *)
datatype 'a rlist = Empty |
RCons of 'a * (('a rlist) ref)
(* Insert takes in three arguments: A comparison function of type 'a * 'a -> bool, an
element of type 'a and a linked list l of type ('a rlist) ref. Function will
destructively update the list l.
f is a function checking whether arg1 before arg2 *)
fun insert(f,x,lst as ref Empty) = (lst := RCons(x,ref Empty))
| insert(f,x,lst as ref (RCons(v,rest))) =
if f(v,x)
then insert(f,x,rest)
else lst := RCons(x,ref (RCons(v,rest)));
(* 2)
'protected "bank account"'*)
datatype transactions =
Withdraw of int | Deposit of int | Check_balance
(* Bank account generator from class. Notice i didnt add a withdraw limit, cuz i
my bank is very lenient and simply uses negative accounts*)
fun make_account(opening_balance:int) =
let
val balance = ref opening_balance
in
fn (Withdraw(x)) => (balance := !balance - x; !balance)
| (Deposit(x)) => (balance := !balance + x; !balance)
| Check_balance => !balance
end;
exception accessdenied;
(* using inheritance -- protected account 0wns (pwns?) unprotected account *)
fun make_protected_account(opening_balance:int, password:string) =
let
val account = make_account(opening_balance)
in
fn (trans,pass) =>
if pass = password
then (account)(trans)
else raise accessdenied
end;
(* 3)
finding set of free variables of MiniML expresssion *)
(* datatype *)
datatype exp = Nat of int | Plus of exp * exp | Minus of exp * exp |
Mult of exp * exp | If of exp * exp * exp | Bool of bool |
And of exp * exp | Not of exp | Eq of exp * exp | Lte of exp * exp |
Var of string | Let of exp * (string * exp) | Fun of string * string * exp |
Apply of exp * exp
(* set functions - a set is represnted by a list - then i can use the definitions in the notes *)
(* REMOVE - returns the set minus the given element *)
fun remove(x, []) = [] (* auxiliary function removes element x from list l *)
| remove(x,l::ls) =
if x = l
then remove(x,ls)
else l::remove(x,ls);
(* UNION - returns the union of two lists (notice the return is a set, meaning it has dups removed) *)
fun union(a,b) =
let fun remDup ([]) = [] (* auxiliary function removes all duplicates *)
| remDup (x::xs) = x::remDup(remove(x,xs))
in remDup(a@b)
end;
4) substitution
(* Data-types*)
datatype primop = Equals | LessThan | Plus | Minus | Times
datatype exp =
Nat of int | Bool of bool | If of exp * exp * exp |
Op of primop * exp list | Var of string |
Let of exp * (string * exp)
(* from ass3:
"let x = e1 in e2 is written in terms of the above datatype as
Let(e1,('x',e2))" *)
(* fresh variable generator *)
local
val counter = ref 0
in
fun freshVar() = (counter := !counter+1; Int.toString (!counter)) (* in my example fresh var returns a wierd sequence 1,5,7... ? *)
end
fun substArg s ([]) = []
| substArg s (a::args) = (subst s a)::(substArg s args)
(*
1) the substution function
subst (e,x) exp
subst: exp * string -> exp -> exp
(e,x) means we get rid of all x and put e there instead, (x->e) or x becomes e
*)
and
subst (_,_) (Nat(a)) = Nat(a)
| subst (_,_) (Bool(a)) = Bool(a)
| subst (e,x) (Var(a)) = if (a = x)
then e
else Var(a)
| subst s (If(e1,e2,e3)) = If(subst s (e1),subst s (e2),subst s (e3)) (* why is If not a primary operation? *)
| subst s (Op(primop,args)) = Op(primop,substArg s args)
| subst (e,x) (Let(e1,(u,e2))) = (* paranoid coding, we always assume bad cases *)
let val z = freshVar()
in
Let((subst (e,x) e1),(z,subst (e,x) (subst (Var(z),u) e2)))
end;
5) Scheme – streams
; 1)
; we want to represent sets by characteristic functions, the question only asks for these
; even numbers
(define (even n) (if (even? n) 1 0))
; perfect squares
(define (square n) (if (integer? (sqrt n)) 1 0))
; intersection
(define (intersection s1 s2) (lambda (n) (min (s1 n) (s2 n))))
; union
(define (union s1 s2) (lambda (n) (max (s1 n) (s2 n))))
; complement
(define (complement s) (lambda (n) (- 1 (s n))))
; given an arbitrary function, it is not possible to determine whether a set is empty, because it
; is not even possible to determine whether a given characteristic function terminates. Even more
; one would have to check over all positive integers which is not possible.
; we assume all functions are of type int -> int, so scheme with its untyped paradigm would not provide
; an example in this regard; however, the cons-streams would make it simpler in scheme to actually
; implement the infinite sets. If one is not interested in these, sml would possible provide a more
; simple syntax to the average programmer.
; 2) expand
; given numeratorm, denominator, base returns decimal expansion of division as infinite stream
; i assume numerator, denominator > 0, base > 1, and numerator < denominator
(define (expand num denom base)
(cons-stream (quotient (* num base) denom)
(expand (remainder (* num base) denom) denom base)
)
)
; 3)
; hamming numbers
; i dont want to mess with merging streams etc (also there seems to be a mistake in the steam merge
; functions on Prakash's webpage - or is it a feature?) so instead i assume the hamming numbers to be a
; three-ary tree, where left is current*2, middle is current*3, right is current*5 - like this:
;… example omitted
; i start with 1 and keep a list of external nodes to get the next element i find the slmallest in the
; list of externals, remove that from the list and add min*(2,3,5). the list of externals is 2*n + 1, where
; n is the number of elements in the tree (i.e. already used in the stream). Since this is linear
; in n, i dont see a size or performance problem (if memory was that much of an issue, one could
; compute the externals everytime, which would implicitly be doing the suggested strategy).
; the thing that creates the next externals given a list of externals
(define (hamhelp extns)
(define m (findmin extns))
(cons-stream
m
(hamhelp (cons (* m 2) (cons (* m 3) (cons (* m 5) (remove m extns))))) ; remove min and add min*2,3,5 - and do hamhelp of that
)
)
; findmin list
; given a list returns smallest element
(define (findmin l)
(if (equal? (cdr l) '())
(car l) ;base case - list only has one element
(min (car l) (findmin (cdr l)))
)
)
; remove n list
; given an n and a list removes all instances of n in the list
(define (remove n l)
(cond ((eq? l '()) '()) ; base case list empty
((= n (car l)) (remove n (cdr l))) ; case list element gets deleted
(else (cons (car l) (remove n (cdr l))))
)
)
; the actual hamnumbers are the one where the possible candidates (externals) are '(1)
(define ham (hamhelp '(1)))
;; A utility function to allow you to see a prefix of a stream.
;; It converts the first n elements of the stream s into a list.
(define (prefix n s)
(if (= n 0)
()
(cons (head s)
(prefix (- n 1)
(tail s)))))
6) streams in sml
(* 1) *)
(* the stream datatype *)
datatype 'a stream = STREAM of (unit -> ('a * 'a stream));
(* especially for the primes things get reaal slow with this definition
better would be something like
stream = ref to (element,stream)| STREAM as above
so that tings don't have to get evaluated multiple times *)
(* the basic stream functions *)
fun force(STREAM(p)) = p();
fun head(STREAM(p)) = #1(p());
fun tail(STREAM(p)) = #2(p());
fun consstream(n,stream) = STREAM(fn() => (n,stream));
(* notice that it is not practical to use consstream
because sml will try to evaluate the argument stream
and therefore often loop to infinity and beyond *)
(* 2) *)
(* returns the first n elements of a stream as a list *)
fun prefix 0 stream = []
| prefix n stream = let val (h,t) = force(stream)
in h::(prefix (n-1) t)
end;
(* 3) *)
(* map stream takes a function and stream and applies
this function to all elements returning a new stream *)
fun mapstream f s =
STREAM(fn() => (f(head(s)),mapstream f (tail(s))));
(* 4) *)
(* expand
given numerator, denominator, base returns decimal expansion of
division as inifite stream. i assume numerator, denominator > 0,
base > 1, and numerator < denominator *)
fun expand(num,denom,base) =
STREAM(fn() => (num*base div denom,
expand(num*base mod denom,denom,base)));
(* 5 *)
(* auxiliary functions for the sieve of primes *)
(* the natural numbers from n as infite stream *)
fun nats(n) = STREAM(fn() => (n,nats(n+1)));
(* filter takes a function 'a to bool and an a' stream and returns
a stream which only has the elements of the input stream on which
the function returns true *)
fun filter(f,stream) =
STREAM(fn() => (* some delay of evaluation *)
if f(head(stream))
then (head(stream),filter(f,tail(stream)))
else force(filter(f,tail(stream))));
(* the sieve function - for any element n of a stream this filters
out all multiples of n in the remainder of the stream *)
fun sieve(stream) =
STREAM(fn() => (head(stream),
sieve(filter((fn(n) => ((n mod head(stream) > 0))),
tail(stream)))
)
);
(* there we go with the primes *)
val primes = sieve(nats(2));
................
................
In order to avoid copyright disputes, this page is only a partial summary.
To fulfill the demand for quickly locating and searching documents.
It is intelligent file search solution for home and business.
Related searches
- mcgill university acceptance rate
- mcgill university tuition international
- mcgill university canada acceptance rate
- mcgill university ranking us news
- mcgill university world ranking
- mcgill university tuition 2020
- mcgill university canada fees
- mcgill university cost for americans
- mcgill university tuition and fees
- mcgill university international tuition
- mcgill university ranking 2020
- mcgill university tuition for americans