(* CS320 Fall 2006 Assignment 4.
 * Likai Liu, Computer Science Department, Boston University.
 *
 * Distribution without permission is prohibited and is a violation of U.S.
 * Copyright Law. Submitting this solution as your own work whether in part
 * or as a whole also violates Academic Code of Conduct.
 *)

(* Problem 1 *)

type matrix = real list list	(* a matrix is a list of rows. *)

exception InvalidArgument

fun matrix_transpose mat =
    let
      fun loop rows =
	  if List.all List.null rows then
	    []
	  else
	    (* if some rows have unequal length, List.hd would raise Empty
	     * when the shortest row is exhausted.
	     *)
	    (List.map List.hd rows) :: loop (List.map List.tl rows)
    in
      loop mat
    end handle List.Empty => raise InvalidArgument

fun vec_dot_product (vec1, vec2) =
    let val xs = ListPair.mapEq ( Real.* ) (vec1, vec2) in
      List.foldl ( Real.+ ) 0.0 xs
    end handle ListPair.UnequalLengths => raise InvalidArgument

fun matrix_mul (mat1, mat2) =
    let
      val mat2t = matrix_transpose mat2
    in
      List.map
	(fn row1 =>
	    List.map (fn col2 => vec_dot_product (row1, col2)) mat2t)
	mat1
    end

(* Problem 2 *)

datatype 'a mylist = Nil
		   | Cons of 'a * 'a mylist
		   | Append of 'a mylist * 'a mylist
		   | Reverse of 'a mylist

fun append (xs: 'a mylist, ys: 'a mylist) =
    Append (xs, ys)

fun reverse (xs: 'a mylist) = Reverse xs

fun is_empty xs =
    case xs of
      Nil => true
    | Cons _ => false
    | Append (ys, zs) => is_empty ys andalso is_empty zs
    | Reverse ys => is_empty ys

fun length xs =
    case xs of
      Nil => 0
    | Cons (_, xs') => 1 + length xs'
    | Append (ys, zs) => length ys + length zs
    | Reverse ys => length ys

local
  exception Carry of int

  fun nth' (xs, i) =
      case xs of
	Nil => raise (Carry i)
      | Cons (x, xs') => if i = 0 then x else nth' (xs', i - 1)
      | Append (ys, zs) =>
	(nth' (ys, i) handle Carry i => nth' (zs, i))
      | Reverse ys =>
	let val len = length ys in
	  if i < len then
	    nth' (ys, len - i - 1)
	  else
	    raise (Carry (i - len))
	end
in
  fun nth (xs, n) =
      nth' (xs, n) handle Carry _ => raise Subscript
end

fun to_list xs =
    case xs of
      Nil => []
    | Cons (x, xs') => x :: to_list xs'

    (* some optimization *)

    | Append (Reverse (Reverse ys), zs) => to_list (Append (ys, zs))
    | Reverse (Reverse xs) => to_list xs
    | Reverse (Append (xs, ys)) => to_list (Append (Reverse ys, Reverse xs))

    (* do actual work *)

    | Append (Reverse ys, zs) => List.revAppend (to_list ys, to_list zs)
    | Append (ys, zs) => List.@ (to_list ys, to_list zs)
    | Reverse ys => List.rev (to_list ys)

(* Problem 3 *)

datatype 'a pair = S of 'a | P of 'a pair * 'a pair
datatype 'a ralist = Empty
		   | Even of 'a ralist
		   | Odd of 'a pair * 'a ralist

fun racons (p, xs) =
    case xs of
      Empty => Odd (p, Empty)
    | Even ys => Odd (p, ys)
    | Odd (q, zs) => Even (racons (P (p, q), zs))

fun rauncons xs =
    case xs of
      Empty => raise InvalidArgument
    | Even ys =>
      let val (P (p, q), ys') = rauncons ys in
	(p, Odd (q, ys'))
      end
    | Odd (p, Empty) => (p, Empty)
    | Odd (p, ys) => (p, Even ys)

local
  fun lookupPair (p, size, i) =
      case p of
	S _ => if i = 0 then p else raise Subscript
      | P (p, q) =>
	let val subsize = size div 2 in
	  if i < subsize then
	    lookupPair (p, subsize, i)
	  else
	    lookupPair (q, subsize, i - subsize)
	end

  fun lookup (xs, size, i) =
      case xs of
	Empty => raise Subscript
      | Even ys => lookup (ys, size * 2, i)
      | Odd (p, ys) =>
	if i < size then
	  lookupPair (p, size, i)
	else
	  lookup (ys, size * 2, i - size)
in
  fun ralookup (xs, i) = lookup (xs, 1, i)
end

local
  fun updatePair (p, size, i, p') =
      case p of
	S x => if i = 0 then p' else raise Subscript
      | P (p, q) =>
	let val subsize = size div 2 in
	  if i < subsize then
	    P (updatePair (p, subsize, i, p'), q)
	  else
	    P (p, updatePair (q, subsize, i - subsize, p'))
	end

  fun update (xs, size, i, p) =
      case xs of
	Empty => raise Subscript
      | Even ys => Even (update (ys, size * 2, i, p))
      | Odd (p0, ys) =>
	if i < size then
	  Odd (updatePair (p0, size, i, p), ys)
	else
	  Odd (p0, update (ys, size * 2, i - size, p))
in
  fun raupdate (xs, i, p) = update (xs, 1, i, p)
end

(* test functions *)

fun raToList xs =
    case xs of
      Empty => []
    | _ => let val (S x, ys) = rauncons xs in x :: raToList ys end

fun raFromList xs =
    List.foldr racons Empty (List.map S xs)

val xs = raFromList [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]