SML TTT Tree

ttt.sml

datatype player = X | O;
datatype cell = Nil | Cell of player;
datatype state = Win of player | Draw;
exception IllegalState;

val newboard = List.tabulate (9, fn _ => Nil);

fun getNext [] _ = []
|	getNext (Nil::cs) p = ((Cell p)::cs) :: map (fn l => Nil::l) (getNext cs p)
|	getNext (c::cs) p = map (fn l => c::l) (getNext cs p)

fun checkWinner [Cell X, Cell X, Cell X,      _,      _,      _,      _,      _,      _] = SOME (Win X)
|	checkWinner [     _,      _,      _, Cell X, Cell X, Cell X,      _,      _,      _] = SOME (Win X)
|	checkWinner [     _,      _,      _,      _,      _,      _, Cell X, Cell X, Cell X] = SOME (Win X)
|	checkWinner [Cell X,      _,      _, Cell X,      _,      _, Cell X,      _,      _] = SOME (Win X)
|	checkWinner [     _, Cell X,      _,      _, Cell X,      _,      _, Cell X,      _] = SOME (Win X)
|	checkWinner [     _,      _, Cell X,      _,      _, Cell X,      _,      _, Cell X] = SOME (Win X)
|	checkWinner [Cell X,      _,      _,      _, Cell X,      _,      _,      _, Cell X] = SOME (Win X)
|	checkWinner [     _,      _, Cell X,      _, Cell X,      _, Cell X,      _,      _] = SOME (Win X)
|	checkWinner [Cell O, Cell O, Cell O,      _,      _,      _,      _,      _,      _] = SOME (Win O)
|	checkWinner [     _,      _,      _, Cell O, Cell O, Cell O,      _,      _,      _] = SOME (Win O)
|	checkWinner [     _,      _,      _,      _,      _,      _, Cell O, Cell O, Cell O] = SOME (Win O)
|	checkWinner [Cell O,      _,      _, Cell O,      _,      _, Cell O,      _,      _] = SOME (Win O)
|	checkWinner [     _, Cell O,      _,      _, Cell O,      _,      _, Cell O,      _] = SOME (Win O)
|	checkWinner [     _,      _, Cell O,      _,      _, Cell O,      _,      _, Cell O] = SOME (Win O)
|	checkWinner [Cell O,      _,      _,      _, Cell O,      _,      _,      _, Cell O] = SOME (Win O)
|	checkWinner [     _,      _, Cell O,      _, Cell O,      _, Cell O,      _,      _] = SOME (Win O)
|	checkWinner l =
	if length l <> 9 then
		raise IllegalState
	else if List.exists (fn Nil => true | _ => false) l then
		NONE
	else
		SOME Draw

datatype boardTree = Result of state | Next of cell list * boardTree list

fun genTree p b =
	case checkWinner b of
			NONE => Next(b, map (genTree (case p of X => O | O => X)) (getNext b p))
		|	SOME(s) => Next(b, [Result s])

type color = bool
type xy = int*int
datatype image = Image of xy * color array array;

fun image dim clr = Image(dim, Array.tabulate((#2 dim), fn i => Array.tabulate((#1 dim), fn j => clr)));

fun size (Image(dim, _)) = dim;

fun drawPixel (Image(dim, data)) clr (pos : xy) =
	Array.update(Array.sub(data, (#2 pos)), (#1 pos), clr)
		handle Subscript => ();

fun drawLine img clr (pos0 : xy) (pos1 : xy) =
	let
		val (x0, y0) = pos0
		val (x1, y1) = pos1
		val dx = Int.abs(x1 - x0)
		val dy = Int.abs(y1 - y0)
		val sx = if x0 < x1 then 1 else ~1;
		val sy = if y0 < y1 then 1 else ~1;

		fun helper x y err = (
			drawPixel img clr (x, y);
			if (x = x1) andalso (y = y1) then ()
			else
				if 2 * err > ~dy then
					if 2 * err < dx then
						helper (x + sx) (y + sy) (err - dy + dx)
					else
						helper (x + sx) y (err - dy)
				else
					if 2 * err < dx then
						helper x (y + sy) (err + dx)
					else
						()
			)
	in
		helper x0 y0 (dx - dy)
	end

fun toPPM (Image((w, h), data)) filename =
		let
			val oc = BinIO.openOut filename

			fun boolListToWord8 l =
			let
				fun helper [] 0 acc = acc
				|	helper _ 0 _ = raise Overflow
				|	helper [] n acc = helper [] (n - 1) (Word8.<< (acc, 0wx1))
				|	helper (x::xs) n acc = helper xs (n - 1) (Word8.orb (Word8.<< (acc, 0wx1), if x then 0wx1 else 0wx0))
			in
				helper l 8 0wx0
			end

			fun softTake _ 0 = []
			|	softTake [] _ = []
			|	softTake (x::xs) n = x :: (softTake xs (n - 1))

			fun softDrop xs 0 = xs
			|	softDrop [] _ = []
			|	softDrop (x::xs) n = softDrop xs (n - 1)

			fun toWord8List [] acc = acc
			|	toWord8List l  acc = toWord8List (softDrop l 8) (acc @ [boolListToWord8 (softTake l 8)]) 

			fun printRow row = BinIO.output(oc, Word8Vector.fromList (toWord8List (Array.foldr (op::) [] row) []))

			fun printData () = 
				let
					fun helper i = 
						if i = h then
							()
						else (
							printRow (Array.sub (data, i));
							helper (i + 1)
						)
				in
					helper 0
				end
		in
			BinIO.output(oc,Byte.stringToBytes("P4 " ^ Int.toString w ^ " " ^ Int.toString h ^ "\n"));
			printData ();
			BinIO.closeOut oc
		end

fun getPixel (Image(_, data)) ((x, y) : xy) = Array.sub(Array.sub(data, y), x)

fun drawAll (Image((w, h), data)) f = Array.appi (fn (y, row) => (Array.modifyi (fn (x, _) => f((x, y) : xy)) row)) data

fun insert img ((x0, y0) : xy) (img2 as Image((w, h), _)) =
	drawAll
	img
	(fn (x, y) =>
		if x < x0 orelse y < y0 orelse x >= x0 + w orelse y >= y0 + h then
			getPixel img (x, y)
		else
			getPixel img2 (x - x0, y - y0)
	)

fun cellToImg Nil =
	Image((9, 9), Array.fromList[
		Array.fromList [ true,  true,  true,  true,  true,  true,  true,  true,  true],
		Array.fromList [ true, false, false, false, false, false, false, false,  true],
		Array.fromList [ true, false, false, false, false, false, false, false,  true],
		Array.fromList [ true, false, false, false, false, false, false, false,  true],
		Array.fromList [ true, false, false, false, false, false, false, false,  true],
		Array.fromList [ true, false, false, false, false, false, false, false,  true],
		Array.fromList [ true, false, false, false, false, false, false, false,  true],
		Array.fromList [ true, false, false, false, false, false, false, false,  true],
		Array.fromList [ true,  true,  true,  true,  true,  true,  true,  true,  true]
	])
|	cellToImg (Cell p) =
	let
		val i = cellToImg Nil
		val i2 = Image((5, 5),
			case p of
					X =>
						Array.fromList[
							Array.fromList[ true, false, false, false,  true],
							Array.fromList[false,  true, false,  true, false],
							Array.fromList[false, false,  true, false, false],
							Array.fromList[false,  true, false,  true, false],
							Array.fromList[ true, false, false, false,  true]
						]
				|	O => Array.fromList[
							Array.fromList[false,  true,  true,  true, false],
							Array.fromList[ true, false, false, false,  true],
							Array.fromList[ true, false, false, false,  true],
							Array.fromList[ true, false, false, false,  true],
							Array.fromList[false,  true,  true,  true, false]
						]
		)
		val _ = insert i (2, 2) i2
	in
		i
	end

fun boardToImg [c11, c12, c13, c21, c22, c23, c31, c32, c33] =
	let
		val i = image (25, 25) false;
		val _ = insert i ( 0,  0) (cellToImg c11);
		val _ = insert i ( 8,  0) (cellToImg c12);
		val _ = insert i (16,  0) (cellToImg c13);
		val _ = insert i ( 0,  8) (cellToImg c21);
		val _ = insert i ( 8,  8) (cellToImg c22);
		val _ = insert i (16,  8) (cellToImg c23);
		val _ = insert i ( 0, 16) (cellToImg c31);
		val _ = insert i ( 8, 16) (cellToImg c32);
		val _ = insert i (16, 16) (cellToImg c33);
	in
		i
	end
|	boardToImg _ = raise IllegalState;

fun stateToImg s =
	let
		val i = image (25, 25) false
		val i2 = cellToImg (case s of Draw => Nil | Win p => Cell p)
		val _ = drawAll i (fn (x, y) => getPixel i2 ((x + 1) div 3, (y + 1) div 3))
	in
		i
	end

fun treeToImg (Result s) = stateToImg s
|	treeToImg (Next (brd, ts)) =
	let
		val imgs = map (treeToImg) ts
		val cur = boardToImg brd
		val width = let val other = foldl op+ 0 (map (fn i => #1(size i) + 3) imgs) + 3 in if other > #1(size cur) then other else #1(size cur) + 6 end
		val height = (foldl (fn (h1, h2) => if h1 > h2 then h1 else h2) 0 (map (fn i => #2(size i)) imgs)) + 2 * #2(size cur)
		val img = image (width, height) false

		val _ = insert img ((width - #1(size cur)) div 2, 0) cur

		fun helper [] _ = ()
		|	helper (i::is) (x, y) = (insert img (x, y) i; drawLine img  true (width div 2, 0 + #2(size cur)) (x + (#1(size i) div 2), y); helper is (x + #1(size i) + 3, y))

		val _ = helper imgs (3, 0 + 2 * #2(size cur))
	in
		img
	end

fun numberOfXWins (Result (Win X)) = 1
|	numberOfXWins (Result _) = 0
|	numberOfXWins (Next(_, ns)) = foldl (op+) 0 (map numberOfXWins ns)

fun numberOfOWins (Result (Win O)) = 1
|	numberOfOWins (Result _) = 0
|	numberOfOWins (Next(_, ns)) = foldl (op+) 0 (map numberOfOWins ns)

fun numberOfDraws (Result Draw) = 1
|	numberOfDraws (Result _) = 0
|	numberOfDraws (Next(_, ns)) = foldl (op+) 0 (map numberOfDraws ns)

;

(*val i = boardToImg [Cell O, Cell O, Cell X, Nil, Nil, Cell X, Cell X, Cell O, Cell O];*)
(*val i = stateToImg (Draw);*)
(*val t = Next(hd (getNext newboard X), [Result Draw, Result (Win X), Next(newboard, [Result Draw, Result (Win O)]), Result Draw, Result (Win O)]);*)

(*fun uptoLevel _ (Result r) = Result r
|	uptoLevel 0 (Next (brd, _)) = Next (brd, [])
|	uptoLevel n (Next (brd, ts)) = Next (brd, map (uptoLevel (n - 1)) ts);*)

(*fun subtree _ (Result r) = Result r
|	subtree 0 t = t
|	subtree n (Next(_, _::t::_)) = subtree (n - 1) t
|	subtree n (Next(_, t::_)) = subtree (n - 1) t*)

(*val whole = genTree X newboard;
val xs = numberOfXWins whole;
val os = numberOfOWins whole;
val ds = numberOfDraws whole;*)

(*val t = subtree 4 whole;*)

val t = genTree O [Nil, Cell X, Cell O, Nil, Cell X, Cell O, Nil, Nil, Cell X]
val i = treeToImg t;
toPPM i "test.ppm";