(* CS320 Fall 2006 Assignment 3.
 * 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.
 *)

(* 'foldl_with_others f xs result' is like 'List.foldl', but for every
 * elements in 'xs', applies 'f' to three arguments: an element, the "others"
 * list, and some previous result. The "others" list is the same as 'xs' but
 * with the element excluded. Choice of elements is from left to right.
 *)

fun foldl_with_others f xs result =
    let
      fun loop (xs, used, result) =
	  case xs of
	    [] => result
	  | x :: xs =>
	    let
	      val others = List.revAppend (used, xs)
	    in
	      loop (xs, x :: used, f (x, others, result))
	    end
    in
      loop (xs, [], result)
    end

(* Problem 1 *)

(* Here we provide two possible ways to implement permutation, and we call
 * them list_permute_1 and list_permute_2 respectively.
 *)

local
  fun permute (xs: 'a list): 'a list list =
      let
	fun assemble (ys_r, x, ys) =
	    List.revAppend (ys_r, x :: ys)

	fun loop (x, ys, ys_r, res) =
	    case ys of
	      [] => List.rev (assemble (ys_r, x, ys) :: res)
	    | y :: ys' =>
	      loop (x, ys', y :: ys_r,
		    assemble (ys_r, x, ys) :: res)

	fun insertEach (x, ys) = loop (x, ys, [], [])
      in
	case xs of
	  [] => [[]]
	| x :: xs =>
	  List.concat
	    (List.map (fn ys => insertEach (x, ys)) (permute xs))
      end
in
  val list_permute_1 = permute
end

local
  fun permute (xs: 'a list): 'a list list =
    case xs of
      [] => [[]]
    | _ =>
      foldl_with_others
        (fn (x, others, res) =>
	    res @ List.map (fn ys => x :: ys) (permute others))
	xs []
in
  val list_permute_2 = permute
end

(* Problem 2 *)

signature RATIONAL = sig
  type t (* for rationals *)

  exception DenominatorIsZero

  val zero: t
  val one: t

  val make: int * int -> t
  val fromInt: int -> t

  val numerator: t -> int
  val denominator: t -> int
  val unmake: t -> int * int

  val isZero: t -> bool
  val isNegative: t -> bool
  val isPositive: t -> bool
  val eq: t * t -> bool

  val neg: t -> t

  val add: t * t -> t
  val sub: t * t -> t
  val mul: t * t -> t

  exception DivisionByZero
  val recip: t -> t
  val div: t * t -> t

  val toString: t -> string
end

structure Rational :> RATIONAL = struct
  type t = int * int

  exception DenominatorIsZero
  exception DivisionByZero

  fun fromInt (n: int): t = (n, 1)

  val zero = fromInt 0
  val one = fromInt 1

  (* Note: this implementation only simplifies when exposing numerator and
   * denominator values to the user.
   *)

  fun make ((a: int), (b: int)): t =
      if b = 0 then raise DenominatorIsZero else (a, b)

  (* Note: we design gcd so if b < 0, then gcd(a, b) < 0. This makes our
   * simplification of rational numbers easy. Just divide by gcd(a, b) to
   * make denominators always positive.
   *)

  fun gcd (a, b) =
      if b = 0 then a else gcd (b, a mod b)

  fun simp (a, b) =
      let
	val d = gcd (a, b)
      in
	(a div d, b div d)
      end

  fun numerator (r: t): int =
      let val (a, _) = simp r in a end

  fun denominator (r: t): int =
      let val (_, b) = simp r in b end

  fun unmake (r: t): int * int =
      simp r

  fun isZero ((a, b): t): bool = (a = 0)

  fun sign ((a, b): t): int =
      Int.sign a * Int.sign b

  fun isNegative r = (sign r = ~1)

  fun isPositive r = (sign r = 1)

  fun eq ((a, b): t, (c, d): t): bool =
      a * d = b * c

  fun neg ((a, b): t): t = (~a, b)

  fun add ((a, b): t, (c, d): t): t =
      (a * d + b * c, b * d)

  fun sub ((a, b): t, (c, d): t): t =
      (a * d - b * c, b * d)

  fun mul ((a, b): t, (c, d): t): t =
      (a * c, b * d)

  nonfix div

  fun div ((a, b): t, (c, d): t): t =
      make (a * d, b * c) handle
      DenominatorIsZero => raise DivisionByZero

  fun recip ((a, b): t): t =
      make (b, a) handle
      DenominatorIsZero => raise DivisionByZero

  fun toString (r: t): string =
      let val (a, b) = simp r in
	if b = 1 then
	  Int.toString a
	else
	  Int.toString a ^ "/" ^ Int.toString b
      end
end

(* Problem 3 *)

structure R = Rational

datatype exp = Const of R.t
	     | Add of exp * exp
	     | Sub of exp * exp
	     | Mul of exp * exp
	     | Div of exp * exp

fun eval (Const r) = r
  | eval (Add (e1, e2)) = R.add (eval e1, eval e2)
  | eval (Sub (e1, e2)) = R.sub (eval e1, eval e2)
  | eval (Mul (e1, e2)) = R.mul (eval e1, eval e2)
  | eval (Div (e1, e2)) = R.div (eval e1, eval e2)

fun toString (Const r) = R.toString r
  | toString (Add (e1, e2)) = "(" ^ toString e1 ^ " + " ^ toString e2 ^ ")"
  | toString (Sub (e1, e2)) = "(" ^ toString e1 ^ " - " ^ toString e2 ^ ")"
  | toString (Mul (e1, e2)) = "(" ^ toString e1 ^ " * " ^ toString e2 ^ ")"
  | toString (Div (e1, e2)) = "(" ^ toString e1 ^ " / " ^ toString e2 ^ ")"

exception InvalidArgument

type result_t = exp list

fun enum_choices (ans: R.t, exps: exp list, result: result_t): result_t =
    case exps of
      [] => raise InvalidArgument

    | e :: [] => (* base case *)
      if R.eq (eval e, ans) handle R.DivisionByZero => false then
	e :: result
      else
	result

    | _ => (* inductive case *)
      foldl_with_others (* repeat over choices of first operand *)
        (fn (e1, others, result) =>
	    foldl_with_others (* repeat over choices of second operand *)
	      (fn (e2, others, result) =>
		  List.foldl (* repeat over choices of operator *)
		    (fn (oper, result) =>
			enum_choices (ans, oper (e1, e2) :: others, result))
		    result [Add, Sub, Mul, Div])
	      others result)
	exps result

fun game_of_ans (ans: R.t, xs: R.t list) =
    enum_choices (ans, List.map Const xs, [])

fun game_of_24 (xs: int list): result_t =
    game_of_ans (R.fromInt 24, List.map R.fromInt xs)

fun print_result (result: result_t): unit =
    List.app
      (fn e => print (toString e ^ " = " ^ R.toString (eval e) ^ "\n"))
      result