This document represents the majority of my revision for ML, as part of the Cambridge Computer Science Tripos Paper 1. For each problem, I present a brief description, my solution, the official solution if it exists and is significantly different to mine, and an explanation. In most cases, the solutions I offer represent my first attempt at the problem, so they may be flawed.
These problems have been taken from a number of sources, most notably ML for the Working Programmer 2nd Edition, Cambridge’s course notes for Foundations of Computer Science, and past tripos papers.
General things that I have learnt:
ins, which returns a list of lists.perms then recursively inserts an item into every position on the previous permutation, computed recursively, while flattening the result.fun cons x xs = x::xs;
fun ins x [] = [[]]
| ins x (y::ys) = (x::y::ys) :: map (cons y) (ins x ys);
fun flatten [[]] = []
| flatten ([]::xss) = flatten xss
| flatten ((x::xs)::xss) = x :: flatten (xs::xss);
fun perms [] = []
| perms [x] = [[x]]
| perms (x::xs) = flatten (map (ins x) (perms xs));
Elegant solution is to use tcons, which conses an item directly into a functional array.
fun tcons v Lf = Br(v, Lf, Lf)
| tcons v (Br(w, t1, t2)) = Br(w, tcons v t2, t1);
fun arrayoflist [] = Lf
| arrayoflist (x::xs) = tcons x (arrayoflist xs);
datatype 'a vtree = Lf of 'a
| Br of ('a vtree) list;
fun flatten [[]] = []
| flatten ([]::xss) = flatten xss
| flatten ((x::xs)::xss) = x :: flatten (xs::xss);
fun flat (Lf v) = [v]
| flat (Br(ts)) = flatten (map flat ts);
val t = Br( [Br([Lf 1, Lf 2, Lf 3]), Br([Br([Lf 3])]), Lf 4, Br([Lf 3]) ]);
fun sum [] = 0
| sum (x::xs) = x + sum xs;
fun count x (Lf v) = if v=x then 1 else 0
| count x (Br(ts)) = sum (map (count x) ts);
ints)predicatefun ints i n = if i > n then [] else i :: ints (i+1) n;
fun remove p [] = []
| remove p (x::xs) = if (p x) then remove p xs
else x :: (remove p xs);
fun sieve [] = []
| sieve (x::xs) = x :: (sieve (remove (fn y => y mod x = 0) xs));
fun primes n = sieve (ints 2 n);
ins inserts an item into an already sorted list. insort calls this function recursively on a list.
fun ins (x, []) = [x]
| ins (x, y::ys) = if x <= y
then x::y::ys
else y::ins(x, ys);
fun insort [] = []
| insort [x] = [x]
| insort (x::xs) = ins(x, insort xs);
Relies on a partition function which splits a list into left and right based on comparison with a pivot. The left and right sublists are then sorted recursively.
fun quick [] = []
| quick [x] = [x]
| quick (pivot::xs) =
let fun part(l, r, []) = quick l @ (pivot :: quick r)
| part (l, r, y::ys) = if y <= pivot
then part (y::l, r, ys)
else part (l, y::r, ys)
in part ([], [], xs) end;
Similar to quicksort, except we just divide the list in the middle rather than comparison-based partitioning.
fun take ([], _) = []
| take (xs, 0) = []
| take (x::xs, k) = x::take(xs, k-1);
fun from ([], _) = []
| from (xs, 0) = xs
| from (x::xs, k) = from(xs, k-1);
fun len [] = 0
| len (x::xs) = 1 + len(xs);
fun merge ([], ys) = ys
| merge (xs, []) = xs
| merge (x::xs, y::ys) =
if x<=y then x::merge(xs, y::ys)
else y::merge(x::xs, ys);
fun mergesort [] = []
| mergesort [x] = [x]
| mergesort (x::xs) =
let val split = len(x::xs) div 2
in merge(mergesort(take(x::xs, split)),
mergesort(from(x::xs, split)))
end;
fun hd (x::_) = x
fun tl (_::xs) = xs
fun null [] = true
| null (_::_) = false;
fun maxl ls: int =
if null (tl ls) then (hd ls) else
if (hd ls) > (hd (tl ls)) then maxl ((hd ls)::(tl (tl ls)))
else maxl ((hd (tl ls))::(tl (tl ls)));
This example is meant to point out the benefits of pattern matching.
fun last [] = raise Match
| last [x] = x
| last (x::xs) = last xs;
Keep taking the tail until the tail is an empty list.
fun take ([], _) = []
| take (x::xs, n) = if n > 0 then x :: take (xs, n-1)
else [];
fun drop ([], _) = []
| drop (x::xs, n) = if n > 0 then drop (xs, n-1)
else (x::xs);
fun nth ([], _) = raise Match
| nth (x::xs, n) = if n > 0 then nth (xs, n-1) else x;
Official solution uses previously defined hd and drop.
fun nth(l,n) = hd(drop(l,n));
fun append (xs, []) = xs
| append ([], ys) = ys
| append(x::xs, ys) = x :: append(xs,ys);
Official solution does the same but with an infix function.
fun rev (x::xs) =
let fun revAppend ([], acc) = acc
| revAppend (x::xs, acc) = revAppend (xs, x::acc)
in revAppend (x::xs, []) end;
fun zip ([], _) = []
| zip (_, []) = []
| zip (x::xs, y::ys) = (x, y) :: zip(xs,ys);
fun unzip [] = ([], [])
| unzip ((x, y)::pairs) =
let val (xs, ys) = unzip pairs
in (x::xs, y::ys) end;
We must now explicitly check for the case where one list is empty.
Write a function to convert an integer into Roman numerals, in the expanded form (e.g. XIIII) and the condensed form (XIV).
I realised that this problem was equivalent to greedily making change, so I was able to do the first part as follows:
fun numerals k =
let fun rn ([], _) = []
| rn ((l, v)::pairs, 0) = []
| rn ((l,v)::pairs, k) =
if k < v then rn (pairs, k)
else l :: rn((l,v)::pairs, k-v)
val letters = [(#"M", 1000), (#"D", 500),
(#"C", 100), (#"L", 50),
(#"X", 10), (#"V", 5),
(#"I", 1)]
in implode(rn (letters, k))
end;
The official solution uses the same algorithm but with string concatenation instead of imploding. I didn’t see that representing them in the proper form is just a matter of using a different dictionary
fun roman (numpairs, 0) = ""
| roman ((s,v)::numpairs, amount) =
if amount<v then roman(numpairs, amount)
else s ^ roman((s,v)::numpairs, amount-v);
val rompairs1 =
[("M",1000), ("D",500), ("C",100), ("L",50),
("X",10), ("V",5), ("I",1)]
rompairs2 =
[("M",1000), ("CM",900), ("D",500), ("CD",400),
("C",100), ("XC",90), ("L",50), ("XL",40),
("X",10), ("IX",9), ("V",5), ("IV",4),
("I",1)];
Write a function to generate all ways of making change given a finite number of each coin denomination in the till.
fun allChange (coins, till, 0) = [coins]
| allChange (coins, [], amt) = []
| allChange (coins, (c, 0)::till, amt) =
allChange (coins, till, amt)
| allChange (coins, (c, n)::till, amt) =
if amt < 0 then []
else allChange(c::coins, (c, n-1)::till, amt - c) @
allChange(coins, till, amt);
Rather than using an append function, it would be more efficient to have an accumulator argument. This solution uses chg to represent one way of making change, and chgs to accumulate all possible ways of making change:
fun change (till, 0, chg, chgs) = (chg::chgs)
| change ([], _, chg, chgs) = chgs
| change (c::till, amt, chg, chgs) =
if amt < 0 then chgs
else change(c::till, amt-c, c::chg,
change(till, amt, chg, chgs))
fun allChange (till, amt) = change(till, amt, [], []);
Using a list of booleans to represent a reversed binary number (e.g. [false, false, false, true] => 1000), compute the sum and product of a binary number.
This problem just involves a lot of boolean logic:
fun bincarry (false, ps) = ps
| bincarry (true, []) = [true]
| bincarry (true, p::ps) = (not p) :: bincarry(p, ps);
fun binsum (c, [], qs) = bincarry(c, qs)
| binsum (c, ps, []) = bincarry(c, ps)
| binsum (c, p::ps, q::qs) =
(* c p q all false *)
if not (c orelse p orelse q) then false::binsum(false, ps, qs)
(* c p q all true *)
else if (c andalso p andalso q) then true::binsum(true, ps, qs)
(* exactly one of c p q true *)
else if (c andalso not p andalso not q)
orelse (p andalso not c andalso not q)
orelse (q andalso not c andalso not p)
then true::binsum(false, ps, qs)
(* exactly two of c p q true *)
else false::binsum(true, ps, qs);
fun binprod ([], _) = []
| binprod (false::ps, qs) = false::binprod(ps, qs)
| binprod (true::ps, qs) =
binsum(false, qs, false::binprod(ps, qs));
The solution uses the same overall strategy, but with much slicker boolean algebra for the sum:
fun carry3(a,b,c) = (a andalso b)
orelse (a andalso c)
orelse (b andalso c);
(*Binary sum: since b=c computes not(b XOR c), the result is a XOR b XOR c*)
fun sum3(a,b,c) = (a=(b=c));
fun bsum (c, [], qs) = bincarry (c, qs)
| bsum (c, ps, []) = bincarry (c, ps)
| bsum (c, p::ps, q::qs) =
sum3(c,p,q) :: bsum(carry3(c,p,q), ps, qs);
Treating decimal numbers as a reversed list of 0-9, define functions that convert between binary and decimal, and define a function to find the factorial of large numbers.
fun sum [] = 0
| sum (x::xs) = x + sum(xs);
fun pow x 0 = 1
| pow x n = if n mod 2 = 0
then pow (x*x) (n div 2)
else x * pow (x*x) (n div 2);
fun binToInt ([], counter) = 0
| binToInt (p::ps, counter) =
(pow 2 counter) * p + binToInt(ps, counter+1);
fun intToDec i = if i < 10
then [i]
else (i mod 10)::intToDec(i div 10);
fun intToBin i = if i < 2
then [i]
else (i mod 2)::intToBin(i div 2);
fun decToInt ([], counter) = 0
| decToInt (d::ds, counter) =
(pow 10 counter) * d + decToInt(ds, counter+1);
fun decrement [1] = []
| decrement (p::ps) = if p = 1 then 0::ps
else 1::decrement ps;
fun fact d =
let fun binfact [1] = [1]
| binfact p = binprod(p, binfact (decrement p))
in binfact (intToBin d)
end;
This solution fits the spec up until the factorial. Because I do not have a function to directly convert from binary to decimal (I do it via an int), I cannot express the large factorial in decimal even though the value has been computed (in binary). I have not yet figured out how the decimal_of_binary function in the official solution works:
fun binary_of_int 0 = []
| binary_of_int n = (n mod 2) :: binary_of_int (n div 2);
val ten = binary_of_int 10;
fun binary_of_decimal [] = []
| binary_of_decimal(d::ds) =
binsum(0, binary_of_int d,
binprod(ten, binary_of_decimal ds));
fun double (0,[]) = []
| double (c,[]) = [c]
| double (c,d::ds) =
let val next = c + 2*d
in (next mod 10) :: double(next div 10, ds) end;
fun decimal_of_binary [] = []
| decimal_of_binary (p::ps) = double(p, decimal_of_binary ps);
fun binfact n =
if n=0 then [1] else binprod(binary_of_int n, binfact(n-1));
rev (decimal_of_binary (binfact 100));
fun compsame (x, 0) = Lf
| compsame (x, n) = Br(x, compsame(x, n-1), compsame(x, n-1));
This works, but notice the repetition of the call to compsame. Thus we can improve using a let construct:
fun compsame (x, 0) = Lf
| compsame (x, n) =
let val subtree = compsame(x, n-1)
in Br(x, subtree, subtree) end;
I used the naive solution of checking the size of subtrees at each node:
fun balanced Lf = true
| balanced (Br(v, t1, t2)) = abs(size t1 - size t2) <= 1
andalso balanced t1
andalso balanced t2;
The official solution is a bit convoluted in my opinion, and I don’t grok the recursion.
exception Unbalanced;
fun bal Lf = 0
| bal (Br(_,t1,t2)) =
let val b1 = bal t1
and b2 = bal t2
in if abs(b1-b2) <= 1 then b1+b2+1
else raise Unbalanced
end;
Check whether t and u satisfy t = reflect(u) without calling reflect.
fun mirror (Lf, Lf) = true
| mirror (_, Lf) = false
| mirror (Lf, _) = false
| mirror (Br(u, t1, t2), Br(v, t3, t4))
= (u = v) andalso mirror (t1, t4)
andalso mirror (t2, t3);
The above solution is correct, but the official solution makes a minor improvement in the pattern matching:
fun mirror (Lf, Lf) = true
| mirror (Br(u, t1, t2), Br(v, t3, t4))
= (u = v) andalso mirror (t1, t4)
andalso mirror (t2, t3)
| mirror _ = false;
In ML, a list is nothing more than nil and ::.
datatype 'a ls = Nil
| Cons of 'a * 'a ls;
The answers use an infix function to redefine ::, but the result is close enough.
The only difference is that we have Lf of 'b.
datatype ('a, 'b) ltree = Lf of 'b
| Br of 'a * ('a, 'b) ltree *
('a, 'b) ltree;
Quite simple to define one using a list.
datatype 'a gtree = Lf
| Br of 'a * ('a gtree list);
However, I had trouble instantiating a tree. Here are three examples (note the bracket hell):
Br(1, [Lf, Lf, Lf]);
Br(1, [Br(2, [Lf]), Lf, Lf]);
Br(1, [Lf, Lf, Br(2, [Lf, Br(2, [Lf, Lf])])]);
Use the recurrence relationship $x^{2n} = (x^2)^n$ and $x^{2n+1} = x* (x^2)^n$ to make this $O(\log n)$.
fun npower (x:real, n, total) =
if n = 0 then total
else if (n mod 2 = 0) then npower(x*x, n div 2, total)
else npower(x*x, n div 2, x * total);
fun pow (x:real, n) = npower (x, n, 1.0);
(* Recursive *)
fun listsum [] = 0
| listsum (x::xs) = x + listsum(xs);
(* Iterative *)
fun itsum ([], total) = total
| itsum (x::xs, total) = itsum(xs, total + x);
fun listsum2 ls = itsum (ls, 0);
fun last [] = []
| last [x] = [x]
| last (x::xs) = last xs;
fun evenIndex [] = []
| evenIndex [x] = [x]
| evenIndex (x::y::xs) = x :: evenIndex(xs);
fun tails [] = [[]]
| tails (x::xs) = (x::xs) :: tails xs;
fun mem (x, []) = false
| mem (x, y::ys) = (x=y) orelse mem (x, ys);
fun union ([], ys) = ys
| union (xs, []) = xs
| union (x::xs, ys) = if mem (x, ys)
then union(xs, ys)
else x :: union(xs, ys);
When I first did this as homework, I think I implemented a pretty naive solution using two accumulators. It works, but it doesn’t really embrace functional programming.
fun sep([], pos, neg) = [pos, neg]
| sep ([x], pos, neg) = if x >= 0 then [x::pos, neg]
else [pos, x::neg]
| sep (x::xs, pos, neg) = if x >=0 then sep(xs, x::pos, neg)
else sep(xs, pos, x::neg);
I’m fairly sure that what I have here is the ‘proper’ solution, though it isn’t actually more efficient.
fun sep [] = ([], [])
| sep (x::xs) =
let val (pos, neg) = sep xs
in
if x >= 0 then (x::pos, neg)
else (pops, x::neg)
end;
Define a function that returns the minimum and a list excluding that minimum. Then recursively call the selection sort function.
fun getmin ([x], xs) = (x, xs)
| getmin (x::y::ys, xs) =
if y < x then getmin (y::ys, x::xs)
else getmin (x::ys, y::xs);
fun selsort [] = []
| selsort (x::xs) =
let val (y, ys) = getmin (l, [])
in y :: selsort(ys)
end;
The bubble function is quite obvious: iterating over the list and swapping elements that are out of order. However, you then need to check if the list is sorted before calling bubble again.
fun bubble [] = []
| bubble [x] = [x]
| bubble (x::y::xs) =
if x <= y then x::bubble(y::xs)
else y::bubble(x::xs);
fun isSorted [] = true
| isSorted [x] = true
| isSorted (x::y::xs) = (x<=y)
andalso isSorted(y::xs);
fun bubblesort [] = []
| bubblesort l = if (isSorted l) then l
else bubblesort (bubble l);
This question is about writing a function that can compare two tuples, where the first and second values of the tuples may be different types (and thus need different ordering functions).
fun intComp (a, b) = a < b;
fun lsComp (xl, yl) = (hd xl) < (hd yl);
fun lexcomp f1 f2 ((x1, y1), (x2, y2)) =
if (x1=x2) then f2 (y1, y2)
else f1 (x1, x2);
lexcomp intComp lsComp ((1, [3,1,1]), (2, [4,2,5]));
lexcomp intComp lsComp ((1, [3,1,1]), (1, [9,2,5]));
lexcomp intComp lsComp ((1, [9,1,1]), (1, [3,2,5]));
i.e every possible ordinary list of zeroes and ones needs to be included in the lazy list. Questions about lazy lists are most easily answered by defining a next function:
fun next [] = [0]
| next [0] = [1]
| next [1] = [0, 0]
| next (x::xs) = if x=0 then 1::xs
else 0::next(xs);
fun zo ls = Cons(ls, fn() => zo (next ls));
zo just applies the next function in sequence. It can be ‘started’ by calling zo [].
Reviewing this problem much later, I am now aware of a nice pattern to generate lazy lists where we want to have all possible items formed by two operations:
fun zo x = Cons(x, fn() => interleave(zo 0::x, zo 1::x));
I personally think the most elegant way is to filter the lazy list from the previous question to check for palindromes.
fun filterq p Nil = Nil
| filterq p (Cons(x, xf)) =
if (p x) then Cons(x, fn() => filterq p (xf()))
else filterq p (xf());
val palindromes = filterq (fn x => (x = rev x)) (zo []);