(*
*
* BU CAS CS 520, F2002
* Assignment 1
*
*)
(* The code was written by Hongwei Xi in September 2002 *)
signature TWENTYFOUR =
sig
val play_game: int list * int -> bool
val play24: int -> int -> int -> int -> bool
end
structure Twentyfour :> TWENTYFOUR =
struct
exception Fatal
fun fatal msg = (print msg; raise Fatal)
structure R = Rational (Int)
val padd = 2 and psub = 2 and pmul = 1 and pdiv = 1
type display = int * string (* priority and expression *)
type card = R.t * display
fun v_of_c ((v, _): card): R.t = v
fun cards_of_ints (ns: int list): card list =
List.map (fn n => (R.rat (n, 1), (0, Int.toString n))) ns
fun isRes (r: R.t, (v, _) : card): bool = R.eq (r, v)
fun isZero ((v, _) : card): bool = R.isZero (v)
fun show_card ((_, (_, s)): card): unit = print s
fun card_op (opname: string,
(v1, (p1, s1)): card, (v2, (p2, s2)): card): card =
case opname of
"+" =>
let
val s1 = if p1 <= padd then s1 else "(" ^ s1 ^ ")"
val s2 = if p2 < padd then s2 else "(" ^ s2 ^ ")"
in
(R.radd (v1, v2), (padd, s1 ^ " + " ^ s2))
end
| "-" =>
let
val s1 = if p1 <= psub then s1 else "(" ^ s1 ^ ")"
val s2 = if p2 < psub then s2 else "(" ^ s2 ^ ")"
in
(R.rsub (v1, v2), (psub, s1 ^ " - " ^ s2))
end
| "*" =>
let
val s1 = if p1 < pmul then s1 else "(" ^ s1 ^ ")"
val s2 = if p2 < pmul then s2 else "(" ^ s2 ^ ")"
in
(R.rmul (v1, v2), (pmul, s1 ^ " * " ^ s2))
end
| "/" =>
let
val s1 = if p1 < pdiv then s1 else "(" ^ s1 ^ ")"
val s2 = if p2 < pdiv then s2 else "(" ^ s2 ^ ")"
in
(R.rdiv (v1, v2), (psub, s1 ^ " / " ^ s2))
end
| _ => fatal ("card_op: unsupported operation: " ^ opname)
val rapp = List.revAppend
infix $
fun x $ y : card list =
let
val r1 = card_op ("+", x, y)
val r2 = card_op ("-", x, y)
val r3 = card_op ("-", y, x)
val r4 = card_op ("*", x, y)
in
if isZero (x) orelse isZero (y) then
[r1, r2, r3, r4]
else
let
val r5 = card_op ("/", x, y)
val r6 = card_op ("/", y, x)
in
[r1, r2, r3, r4, r5, r6]
end
end
fun member ((x, y): R.t * R.t, xys: (R.t * R.t) list): bool =
case xys of
[] => false
| (x', y') :: xys' =>
R.eq (x, x') andalso R.eq (y, y') orelse member ((x, y), xys')
fun play_game (ns: int list, n: int): bool =
let
val res = R.fromInt n
fun main (zs: card list, xys: (R.t * R.t) list): bool =
case zs of
[x] =>
if isRes (res, x) then
(show_card (x);
print (" = " ^ (R.toString res) ^ "\n");
true)
else false
| x :: y :: zs => aux1 (x, [], y, [], zs, xys)
| _ => fatal ("main: empty list")
and aux1 (x, xs, y, ys, zs, xys) =
if member ((v_of_c x, v_of_c y), xys) then
aux2 (x, xs, y, ys, zs, xys)
else aux11 (x $ y, x, xs, y, ys, zs, xys)
and aux11 ([], x, xs, y, ys, zs, xys) =
aux2 (x, xs, y, ys, zs, (v_of_c x, v_of_c y) :: xys)
| aux11 (r :: rs, x, xs, y, ys, zs, xys) =
main (rapp (xs, rapp (ys, r :: zs)), []) orelse
aux11 (rs, x, xs, y, ys, zs, xys)
and aux2 (x, xs, y, ys, zs, xys) =
case zs of
[] => (case rapp (ys, [y]) of
x' :: y' :: zs' =>
aux1 (x', x :: xs, y', [], zs', xys)
| _ => false)
| z :: zs => aux1 (x, xs, z, y :: ys, zs, xys)
in
main (cards_of_ints ns, [])
end
fun play24 n1 n2 n3 n4: bool = play_game([n1,n2,n3,n4], 24)
end