Tic-Tac-Toe: Scheme

I love LISPs. I confess: it’s partly visual. There’s just something very appealing about all the parentheses cascading their way down the buffer. It’s like programming with bubbles.

Scheme in particular is my favorite because it’s so clean and compact. I can’t say I’ve ever found any particularly practical use for it, personally, but it makes me happy just knowing it exists. No special insights either, since the functional techniques it encourages are part of the air I breath now, but it was nice to spend some time with an old friend.

Actually, that’s not true. One thing that’s notable is that the compiled version of this is an order of magnitude slower than every other implementation so far: 5 seconds vs. about 0.5 seconds. Any schemers out there who can shed light on what I’m doing wrong? I’m not using any special command line flags beyond --exe.

This was written for MzScheme 4.2.2.

#lang scheme

; Defining the players
(define o 'O)
(define x 'X)

(define (other-player player)
  (case player
    ((X) o)
    ((O) x)))

; Setting up the board
(define *starting-board* 
  '((1 2 3)
    (4 5 6)
    (7 8 9)))

(define (space-available? space board)
  (let ((member-space (lambda (row) (member space row))))
    (ormap member-space board)))

; Moving -- returns a transformed board
(define (move player space board)
  (letrec ((move-in-row
            (lambda (row)
              (cond
                ; if we reach the end, that's it
                [(null? row) '()]
                ; if we have found the space, take it 
                [(eqv? space (first row)) (cons player (rest row))]
                ; if not, keep going
                [else (cons (first row) (move-in-row (rest row)))]))))
        (map move-in-row board)))
        
(define (board->string board)
  (let* ([space->string 
          (lambda (space)
            (cond 
              [(number? space) (string-append "(" (number->string space) ")")]
              [(symbol? space) (string-append " " (symbol->string space) " ")]
              [else ""]))]
         [row->string
          (lambda (row) (string-append* (add-between (map space->string row) "|")))])
    (string-append* (add-between (map row->string board) "\n---+---+---\n"))))

(define (winner? board)
  (let ([all-eq?
         (lambda (lst) 
           (foldl (lambda (x y) (if (eq? x y) x #f)) (first lst) (rest lst)))])
    (findf (lambda (x) x)
           (list
            ; rows
            (all-eq? (first board))
            (all-eq? (second board))
            (all-eq? (third board))
            ; columns
            (all-eq? (map first board))
            (all-eq? (map second board))
            (all-eq? (map third board))
            ; diagonals
            (all-eq? (list (first (first board))
                           (second (second board)) 
                           (third (third board))))
            (all-eq? (list (third (first board)) 
                           (second (second board)) 
                           (first (third board))))))))

(define (full? board)
  (not (findf number? (flatten board))))

(define (display-board board)
  (begin
    (newline)
    (display (board->string board))
    (newline)
    (newline)))

(define (play board player)
  (begin
    (display-board board)
    (let ((winning-player (winner? board)))
      (cond
        [winning-player (display (string-append (symbol->string winning-player) " Wins!\n"))]
        [(full? board) (display "It's a Draw!\n")]
        [else (begin
                (display (string-append "Select a square, " (symbol->string player) ": "))
                (let ((answer (string->number (regexp-replace* #px"\\s*" (read-line) ""))))
                  (if (and answer (space-available? answer board)) 
                      (play (move player answer board) (other-player player))
                      (play board player))))]))))
 
(play *starting-board* x)
 

Tic-Tac-Toe: Bourne-Again Shell

With gratuitous use of the filesystem:

#!/usr/bin/env bash

# Set up the board scratch pad
cd $TMPDIR

ALLSPOTS="1 2 3 4 5 6 7 8 9"

function define-row () {
	[ -d rows ] || mkdir rows
	mkdir rows/$1 
	for i in $2 $3 $4; do
		ln -sf ../../$i rows/$1/$i 
	done
}

function initialize-board () {
	if [ -d tic-tac-toe ]; then
		rm -fr tic-tac-toe
	fi

	mkdir tic-tac-toe && cd tic-tac-toe

	cat > display-board < X
	echo "O" > O

	# Start with X
	ln -s X player

	# Make blank starting squares
	touch $ALLSPOTS

	# Define sets of links to the squares to represent rows
	define-row h1 1 2 3
	define-row h2 4 5 6
	define-row h3 7 8 9

	define-row v1 1 4 7
	define-row v2 2 5 8
	define-row v3 3 6 9

	define-row d1 1 5 9
	define-row d2 3 5 7
}

function place-move () {
	cat player > "$1"
	sed -i -e "s/(${1})/ $(cat player) /;" display-board 
}

function swap-players () {
	ln -sf $(cat player | tr XO OX) player
}

function detect-result () {

	# Win
	for row in rows/*; do
		n=$(grep -l `cat player` $row/* | wc -l)
		if [ "$n" -ge 3 ]; then
			cat display-board
			echo "$(cat player) Wins!"
			exit 0
		fi
	done

	# Draw
	n=$(cat $ALLSPOTS | wc -l)
	if [ "$n" -ge 9 ]; then
		cat display-board
		echo "It's a Draw!"
		exit 0
	fi

	# Continue
	swap-players
}
	
initialize-board

while true; do

	cat display-board

	echo -n "Select a square, $(cat player): "
	read square

	if [ "$square" -ge 1 -a "$square" -le 9 -a ! -s "$square" ]; then
		place-move $square
		detect-result
	fi

done

Tic-Tac-Toe: OCaml

So, small confession, and a bit of history. I actually wrote this code about three years ago, over a couple evenings, in a hotel in New Delhi. It was the seed of the whole project actually, after a colleague told me he’d write tic-tac-toe to learn a new language.

So, impressions. After I wrote this, I started acutely noticing the absence of type inference and, especially, pattern matching in the rest of my life. It pushes your thinking to the start of the project in a very elegant and rewarding way. The win-condition code especially drove this home, because even though it was a bit more verbose than other methods, it was easy to make patterns that obviously, visually depicted what I was trying to do.

I did spend a fair bit of time fighting with the compiler, but by the time I satisfied it, damned if the thing didn’t just work on the first try. (I had that impression coming to Java from C many years ago, so who can say if that means anything…) I can also imagine working against some deadline and having the language force me into doing things The Right Way instead of the expedient, hacky, get-it-done-NOW way being pretty frustrating. Does the extra discipline mean you find yourself in those kinds of predicaments less often? Would love to hear from a real Ocamler on the subject.

As my computer languages professor said about SML, “its concrete syntax is not the most attractive.” I actually kind of like how it flows on the screen, but figuring out the rules about when expressions terminate, and when to use “;;” and did involve some head-scratching.

Update: Commenters on reddit showed me the error of my ways, and the dreaded “;;”s are gone.

The code (For ocaml version 3.11.1):

open List
open String
open Printf

(******************)
(* Representation *)
(******************)

(* Individual TTT square.  Also represents the player. *)
type square = X | O | Empty of int 

(* Game Result *)
type result = Continue of square | Win of square | Draw 

(* Initial Empty Board *)
let starting_grid = [[ Empty 1; Empty 2; Empty 3];
                     [ Empty 4; Empty 5; Empty 6];
                     [ Empty 7; Empty 8; Empty 9]] 

(* X always goes first *)
let starting_player = X

(* Return new square if current matches the target slot *)
let update_square replacement target_slot_no current =
    match current with
    | Empty slot_no when slot_no = target_slot_no -> replacement
    | current -> current

(* Replace the given slot in the grid with the new square *)
let update_grid grid replacement target_slot_no = 
    map (map (update_square replacement target_slot_no)) grid

(* Toggle X and O *)
let swap square = match square with X -> O | O -> X | square -> square

(* Determine win/lose/draw for a grid. *)
let result_of_grid current_player grid =

    let is_empty square =
        match square with Empty _ -> true | square -> false in

    let not_full grid =
        exists is_empty (flatten grid) in

    let next_player grid =
        if ((List.length (filter is_empty (flatten grid))) mod 2) = 1 then
            starting_player
        else
            swap starting_player in

    match grid with

    | [[a; _; _];  (* Diagonals *)
       [_; b; _];
       [_; _; c]] when a = b && b = c -> Win a
    | [[_; _; a];
       [_; b; _];
       [c; _; _]] when a = b && b = c -> Win a

    | [[a; b; c];  (* Horizontals *)
       [_; _; _];
       [_; _; _]] when a = b && b = c -> Win a
    | [[_; _; _];
       [a; b; c];
       [_; _; _]] when a = b && b = c -> Win a
    | [[_; _; _];
       [_; _; _];
       [a; b; c]] when a = b && b = c -> Win a

    | [[a; _; _];  (* Verticals *)
       [b; _; _];
       [c; _; _]] when a = b && b = c -> Win a
    | [[_; a; _];
       [_; b; _];
       [_; c; _]] when a = b && b = c -> Win a
    | [[_; _; a];
       [_; _; b];
       [_; _; c]] when a = b && b = c -> Win a

    (* If there's no winner, but empty squares remain, keep playing. *)
    | grid when not_full grid -> Continue (next_player grid)

    (* Otherwise, it must be a draw. *)
    | grid -> Draw

    (* XXX There's probably a better way to do this. XXX *)

(**********)
(* Output *)
(**********)

(* String Representations *)
let x_mark_str	= "X"
let o_mark_str	= "O"
let wall_str	= "|"
let floor_str	= "\n---+---+---\n"

(* Convert a square type to its string representation *)
let string_of_square square =
    match square with 
    | Empty n -> string_of_int n
    | X -> x_mark_str
    | O -> o_mark_str

(* Output the concrete grid representation of a square *)
let concrete square =
    match square with 
    | Empty n -> sprintf "(%d)" n
    | square -> sprintf " %s " (string_of_square square)

(* Convert a whole grid to its string representation *)
let concrete_grid grid = map (map concrete) grid

(* Print the converted grid *)
let print_grid grid = 
    let rows = map (concat wall_str) (concrete_grid grid) in
    printf "\n%s\n" (concat floor_str rows)

(* String representation of result type *)
let string_of_result result =
    match result with
    | Continue player -> sprintf "Select a square, %s: "  (string_of_square player)
    | Win player -> sprintf "%s Wins!" (string_of_square player)
    | Draw -> "It's a Draw!"

(*********)
(* Input *)
(*********)

(* Read a number from standard input *)
let read_slot_no result =
    printf "\n%s"  (string_of_result result);
    try int_of_string (read_line())
    with Failure("int_of_string") -> -1

(* Main Game Loop *)
let rec game_loop current_player grid =

    let result = result_of_grid current_player grid in
    let next_grid player = update_grid grid player (read_slot_no result) in

    print_grid grid;

    match result with
    | Continue player -> game_loop player (next_grid player)
    | result -> result

let () = printf "\n%s\n"  (string_of_result (game_loop starting_player starting_grid)) 

Tic-Tac-Toe: REBOL

REBOL is pretty weird. It clearly owes a lot to LISP and to some extent Smalltalk in its underpinnings.  Code and data both come grouped into “blocks” which behave like mutable arrays by default, and can be coerced into being lists or hashes.  It has first-class functions, but it doesn’t seem to encourage a very functional style in general.  It has objects, but once again doesn’t really push them.  What I found most notable though were the unique syntax features.

It has an incredibly rich set of built-in datatypes, including URIs, filesystem paths, dates, money, email addresses, and more.  A part of me quails a bit at the thought of parsing all these, but it actually highlights how silly it is that these highly standardized formats are treated as raw strings, that must be parsed at runtime, in every other language.  Especially in languages which consider themselves statically typed.   I wish my problem domain had afforded more of an opportunity to try these out.

Slash (/) is used as the “refinement” operator.  Applied to a function, it alters the meaning of the function in some way, possibly requiring new arguments, very similar to how command line flags alter the action of a program invocation in unix.  Applied to a an object, it accesses members.  Applied with a literal number to a data block, it’s an index operator.  For file paths, it descends.  Etc.

It claims to be easier to learn if you’re not already a programmer.  I tend to be skeptical of such claims, or at least skeptical that such a language is actually better-suited to the non-programmer-but-technical crowd (mostly scientists and engineers, I figure) that uses them.  This one might have a claim to it, but it does seem like it could have kept all the features that make it interesting without diverging as wildly.  But I have too many lines logged as a programmer to be able to evaluate that claim properly.

Next time I have a very network-oriented scripting task, I may give REBOL a shot.  If it had an Open Source license, I’d consider it for more than that.

The code (written for version 2.7.7):

#!/usr/bin/env rebol -q

REBOL []

player: 'X

board: [1 2 3 4 5 6 7 8 9]

cell2string: func [cell] [
	either integer? cell
		[ join "(" [cell ")"] ]
		[ join " " [cell " "] ]
]
		
print_board: does [
	repr: []
	clear repr
	for row 0 6 3 [
		for col 1 3 1 [
			append repr cell2string pick board (row + col)
			append repr either col < 3 [ "|" ][ "^/" ]
		]
		if row < 6 [ append repr "---+---+---^/" ]
	]
	print join "^/" repr
]

make_move: func [space] [
	if (pick board space) == space [poke board space player]
]

cells_equal: func [value spaces] [
	foreach space spaces [
		if value  pick board space [return false]
	]
	return true
]
		
winner?: does [
	p: other_player
	if any [
		cells_equal p [ 1 2 3 ]
		cells_equal p [ 4 5 6 ]
		cells_equal p [ 7 8 9 ]
		cells_equal p [ 1 4 7 ]
		cells_equal p [ 2 5 8 ]
		cells_equal p [ 3 6 9 ]
		cells_equal p [ 1 5 9 ]
		cells_equal p [ 3 5 7 ]
	] [
		player: p
		true
	]
		
]

tie?: does [
	foreach cell board [  if integer? cell [return false] ]
	return true
]

prompt: does [
	case [
		winner? [(print [player "Wins!"]) break]
		tie?    [(print "It's a Draw!") break]
		true    [ prin join "Select a square, " [player ": "] ]
	]
]
	

other_player: does [
	either player = 'X ['O]['X]
]

forever [
	print_board 
	prompt
	move: to-integer input
	if (make_move move) [player: other_player]
]