CS1 Supervision 4.sml

(* 8.2 *)

(* I'm not really sure whether this is the right
   interpretation. *)
(* Returns whether (f x, f' x) is lexicographically
   less than or equal to (f y, f' y). *)
fun dualOrdering f f' (x, y) =
    case Int.compare (f x) (f y) of
          LESS    => true
        | GREATER => false
        | EQUAL   => case Int.compare (f' x) (f' y) of
              GREATER   => false
            | otherwise => true;


(* 8.3 *)

(* We've done this already, but I was asked to do it in
   a single function definition. It's a bit hacky, but
that's cool, I guess. *)
fun map2 f [] = []
  | map2 f ([]::xss) = [] :: map2 f xss
  | map2 f [x::xs]   = [f x :: hd (map2 f [xs])]
  | map2 f (xs::xss) = hd (map2 f [xs]) :: map2 f xss;


(* 8.4 *)

(* Either this... *)
fun fmap f (SOME x) = SOME (f x)
  | fmap f NONE = NONE;

(* Or this. Heck, I'm not sure if you can even use
   this, though, because it keeps setting my NONEs
   to unique monotypes. *)
fun mmap f (SOME x) = f x
  | mmap f NONE = NONE;


(* 8.5 *)

fun cons x y = x :: y;

fun change (till,    0)   = [[]]
  | change ([],      amt) = []
  | change (c::till, amt) =
        if amt < c then change (till, amt)
        else map (cons c) (change (c::till, amt-c)) @
             change (till, amt);


(* 9.1 *)

datatype 'a seq = Nil | Cons of 'a * (unit -> 'a seq);

fun seqMap f Nil = Nil
  | seqMap f (Cons (x, xs)) = Cons (f x, fn()=> seqMap f (xs()));


(* 9.2 *)

fun seqConcat Nil = Nil
  | seqConcat (Cons (Nil, ss)) = seqConcat (ss())
  (* Make sure to be as lazy as possible! *)
  | seqConcat (Cons (Cons (i, is),   ss)) =
        Cons (i, fn()=> seqConcat (Cons (is(), ss)));

(* In order to test this... *)
fun list2seq [] = Nil
  | list2seq (x::xs) = Cons (x, fn()=> list2seq xs);

fun seqRepeatN 0 s = Nil
  | seqRepeatN n s = Cons (s, fn()=> seqRepeatN (n-1) s);

fun take 0 _ = []
  | take 1 (Cons (x, xs)) = [x]
  | take n (Cons (x, xs)) = x :: take (n-1) (xs());

(* And testing... *)

take 12 (seqConcat (seqRepeatN 4 (list2seq [1, 2, 3])));
(* val it = [1, 2, 3, 1, 2, 3, 1, 2, 3, 1, ...]: int list *)

take 13 (seqConcat (seqRepeatN 4 (list2seq [1, 2, 3])));
(* Exception- Match raised *)

(* It's lazy, too *)
take 100 (seqConcat (seqRepeatN ~1 (list2seq [1, 2, 3])));
(* val it = [1, 2, 3, 1, 2, 3, 1, 2, 3, 1, ...]: int list *)


(* 9.3 *)

(* Turn a list of (unit -> 'a seq) into a single sequence of type 'a. *)
fun seqJoinLazy ss = (seqConcat o seqMap (fn x => x()) o list2seq) ss;


(* This seems to be totally lazy but it's hard to tell. At the very
   least it's mostly lazy, though, 'cause otherwise it wouldn't be
   as fast as it is. For till = [4, 3, 2, 1], amt = 100000, there
   was noticable but small lag. This implies that time is approximately
   O(n), as O(n^2) or higher would have taken much more than that.

   The time to generate each successive element seems to be roughly
   constant, although it peaks when backtracking increases. *)
fun change till      0   = list2seq [[]]
  | change []        amt = Nil
  | change (c::till) amt =
        if amt < 0 then Nil
        else
            seqJoinLazy [
                fn()=> seqMap (cons c) (change (c::till) (amt-c)),
                fn()=> change till amt
            ];


(* 9.4 *)

(* If you're wondering about the naming, I was trying to do this from scratch with no
   console to test with and no previous context to use. It went OK, bar three mistakes:

        * Forgetting to call xs, ls and rs
        * Dropping the "L" from "LNil" once, inside lazyJoin's declaration
        * Writing "lazyTree" instead of "lazyList" inside lazyList's declaration

   On a real exam, how much would those errors have cost, mark-wise? *)

datatype 'a lazyList = LNil | LCons of 'a * (unit -> 'a lazyList);
datatype 'a lazyTree = TNil | TBranch of 'a * (unit -> 'a lazyTree) * (unit -> 'a lazyTree);

fun lazyJoin LNil ys = ys
  | lazyJoin (LCons (x, xs)) ys = LCons (x, fn()=> lazyJoin (xs()) ys);

fun lazyTree2lazyList TNil = LNil
  | lazyTree2lazyList (TBranch (x, ls, rs)) = LCons (
            x,
            fn()=> lazyJoin
                (lazyTree2lazyList (ls()))
                (lazyTree2lazyList (rs()))
        );


(* Functions used for testing after-the-fact. *)

fun take 0 _ = []
  | take 1 (LCons (x, xs)) = [x]
  | take n (LCons (x, xs)) = x :: take (n-1) (xs());

fun mkTree 0 = TNil
  | mkTree n = TBranch (n, fn()=> mkTree (n-1), fn()=> mkTree (n-1));



(* 10.3 *)

(* UNTESTED, sorry *)

fun breadth q =
    if qnull q then []
    else
        let val qhd_q = qhd q
        in
            if qnull qhd_q
            then breadth (deq q)
            else
                let val Br (v, t, u) = qhd_q
                in v :: breadth (enq (enq (deq q, t) u))
                end
        end;


(* 11.1 *)

(* Membership test *)
(* Because these are linked lists, the best we can do is still O(n) *)
fun isSetMember item = List.exists (fn x => x = item);

(* Subset test *)
fun isSubset [] _ = true
  | isSubset _ [] = false
  | isSubset (x::xs) (y::ys) =
        case Int.compare (x, y) of
              LESS    => false
            | EQUAL   => isSubset xs ys
            | GREATER => isSubset (x::xs) ys;

(* Union *)
fun setUnion (x::xs) (y::ys) = (
        case Int.compare (x, y) of
              LESS    => x :: setUnion xs (y::ys)
            | EQUAL   => x :: setUnion xs ys
            | GREATER => y :: setUnion (x::xs) ys
  ) (* ... and this is why meaningful indentation is good *)
  | setUnion xs ys = xs @ ys;

(* Intersection *)
fun setIntersection (x::xs) (y::ys) = (
        case Int.compare (x, y) of
              LESS    =>      setIntersection xs (y::ys)
            | EQUAL   => x :: setIntersection xs ys
            | GREATER =>      setIntersection (x::xs) ys
  )
  | setIntersection xs ys = [];


(* 12.2 *)

fun power x n =
    let val x = ref x
        val p = ref 1
        val n = ref n
    in while !n <> 1 do (
            if !n mod 2 = 1 then p := !p * !x else ();

            x := !x * !x;
            n := !n div 2
        );
        !p * !x
    end;


(* 12.5 *)

fun identityMatrix n =
    Array.tabulate (n, fn x =>
        Array.tabulate (n, fn y => if y = x then 1 else 0)
    );

(* There is no truly sensible default when either width or height is
   zero, so I'm leaving that behaviour undefined. *)
fun transposeMatrix xss =
    Array.tabulate (Array.length xss, fn x =>
        Array.tabulate (Array.length (Array.sub (xss, 0)), fn y =>
            Array.sub (Array.sub (xss, y), x)
        )
    );