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.

Google Online Preview   Download