Noughts and Crosses in Common Lisp

#|  This file at:

http://interweave-consulting.blogspot.co.uk/2017/01/noughts-and-crosses-in-common-lisp.html

This is the complete code in Common Lisp for implementing the game of noughts and crosses (tic-tac-toe). You should be able to select this entire post, paste it into a CL system, and compile and load.

Some examples are here.

There are three kinds of players defined: humans, random players and a minimax player which searches a game-tree to a configurable depth.

To invoke the three kinds of players use one of these function calls - see the end of the file.

(play-game 'X *initial-board* #'human #'human)

(play-game 'X *initial-board* #'rand-player #'human)

(play-game 'X *initial-board* #'mx-player-X #'human)

A game looks like this (using the random player). Warning: there may still be bugs - I have not tested the functions to death, particularly minimax.

---------

|#

;;; Noughts and Crosses
;;; Functions to explore game tree management and minimax
;;;
;;; December 29th 2016 - January 25th 2017
;

; ------------------- Datatype BOARD ------------------------------------

(defparameter *initial-board* '(0 1 2 3 4 5 6 7 8))   ; empty board

(defvar *win-score*   32)   ; the score assigned to a terminal win position
(defvar *lose-score* -32)   ; the score assigned to a terminal lose position
(defvar *draw-score*   0)   ; the score assigned to a terminal draw position

(defun print-board (b)
(let   ((b0 (nth 0 b))
         (b1 (nth 1 b))
         (b2 (nth 2 b))
         (b3 (nth 3 b))
         (b4 (nth 4 b))
         (b5 (nth 5 b))
         (b6 (nth 6 b))
         (b7 (nth 7 b))
         (b8 (nth 8 b)))
         (format t "~%")
  (format t "     ~{~a~^ | ~} ~%" (list b0 b1 b2))
  (format t "     ~{~a~^ | ~} ~%" (list b3 b4 b5))
(format t "     ~{~a~^ | ~} ~%" (list b6 b7 b8))
          ))

; This is the output of 'print-board' when applied to *arbitrary*
;
;     X | 1 | O
;     O | 4 | 5
;     X | 7 | X

; These parameters available for testing

(defparameter *top-side-win* '(X X X 3 4 5 6 7 8))
(defparameter *bot-side-win* '(0 1 2 3 4 5 X X X))
(defparameter *arbitrary*    '(X 1 O O 4 5 X 7 X))
(defparameter *end-in-draw*  '(X X O O X X X O O))   ; this is a draw position


(defun opp (m)  ; MARK -> MARK    - switches player around
  (if (equal m 'X) 'O 'X) )


(defun triple-score (m r)  ; MARK x POSITION-list -> Int
  "my good positions - opponent's good positions"
  (let ((good  (if (zerop (count (opp m) r)) (count m r) 0) )
        (bad   (if (zerop (count m r)) (count (opp m) r) 0)) )
    (- good bad)  ))

(defun heuristic-score (m B)    ; MARK x BOARD -> Nat
  "heuristic score absolute value <= around 4 or 5 "
  (let ((sum1 (triple-score m (list (nth 0 B) (nth 1 B) (nth 2 B))))
          (sum2 (triple-score m (list (nth 3 B) (nth 4 B) (nth 5 B))))
          (sum3 (triple-score m (list (nth 6 B) (nth 7 B) (nth 8 B))))
          (sum4 (triple-score m (list (nth 0 B) (nth 3 B) (nth 6 B))))
          (sum5 (triple-score m (list (nth 1 B) (nth 4 B) (nth 7 B))))
          (sum6 (triple-score m (list (nth 2 B) (nth 5 B) (nth 8 B))))
          (sum7 (triple-score m (list (nth 0 B) (nth 4 B) (nth 8 B))))
          (sum8 (triple-score m (list (nth 2 B) (nth 4 B) (nth 6 B)))) )
    (+ sum1 sum2 sum3 sum4 sum5 sum6 sum7 sum8)  ))


(defun is-win (mark B)  ; MARK x BOARD -> Bool
  "mark is X or O, B is the board"
  (let ((triple (list mark mark mark)))
    (or (equal triple (list (nth 0 B) (nth 1 B) (nth 2 B)))
          (equal triple (list (nth 3 B) (nth 4 B) (nth 5 B)))
          (equal triple (list (nth 6 B) (nth 7 B) (nth 8 B)))
          (equal triple (list (nth 0 B) (nth 3 B) (nth 6 B)))
          (equal triple (list (nth 1 B) (nth 4 B) (nth 7 B)))
          (equal triple (list (nth 2 B) (nth 5 B) (nth 8 B)))
          (equal triple (list (nth 0 B) (nth 4 B) (nth 8 B)))
          (equal triple (list (nth 2 B) (nth 4 B) (nth 6 B)))
        )))

(defun is-draw (b)  ; BOARD -> BOOL
   (null (remove 'O (remove 'X b))))


; ------------------ Datatype OXO-NODE -----------------------------
;
;  BOARD x MOVE (Nat) x SCORE (Nat)
;
;  MOVE: 9 is the non-assigned move (legal values 0-8)
;                the number is the move which got to this node.
;
;  SCORE: only applies to minimax.
;         t is the non-assigned score (assigned scores are terminal,
;         heuristic or backed up via minimax).
;

(defun mknode (board move score)
  "node is board + move (undefined=9 or 0-8) + board-score (undefined=t)"
  (list board move score))

(defparameter *initial-node*   (mknode *initial-board* 9 t))      ; empty root node

; ------------- Node projection functions -----------------------------------

(defun board (n)     ; OXO-NODE -> BOARD (1st element)
   (car n))

(defun cmove (n)  ; OXO-NODE -> Nat (2nd element)  --  Index number of current move
   (cadr n))

(defun score (n)     ;  OXO-NODE -> Nat (3rd element) -- (backed up) board rating
   (caddr n))


; ------------------- Datatype OXO-TREE --------------------------------------
;

(defun mktree (node treelist)  ; OXO-NODE x TREE-list -> TREE
  "build a tree"
  (list node treelist))

(defun tree-node (tree)
   (car tree))

(defun tree-children (tree)    ; TREE -> TREE-list
   (cadr tree))

(defun leafp (tree)    ; TREE -> bool
   (null (tree-children tree)))


; ----------- XTREE: the main function to build a game-tree to depth n -----

(defun xtree (s m n d)  ; MARK x MARK x OXO-NODE x Nat -> TREE
  "Generate game tree. Mark s is the mark the player is playing (X or O).
   Mark m to move next. Initial node n to depth d"
  (let ( (s1 (opp s))
           (m1 (opp m))
           (b   (board n))
           (i    (cmove n))  )
    (cond ((is-win s b)   (mktree (mknode b i *win-score*)  nil) )
          ((is-win s1 b)     (mktree (mknode b i *lose-score*) nil) )
          ((is-draw b)       (mktree (mknode b i *draw-score*) nil) )
          ((zerop d)          (mktree (mknode b i (heuristic-score m b)) nil))
          ( t                      (mktree n
                                                (mapcar #'(lambda (n1) (xtree s m1 n1 (1- d)))
                                                                       (mk-children m n) ) ))
          ) ) )

; -----------MK-CHILDREN: main function for building a game-tree -----------

(defun mk-children (m n)  ; MARK x OXO-NODE -> OXO-NODE-list
  "From  (board node) creates list of possible next-boards, then
   changes them into nodes.
   The 'currently unknown' board-score is t, meaning unassigned"
    (let ((possibles (poss-boards m (board n) ) ) )
         (mapcar #'(lambda (b i) (mknode b i t))                            ; create a child-node
                     (car  possibles)                                                       ; .. over list of boards
                     (cadr possibles)  )  ))                                              ; ..  and list of moves


(defun poss-boards (m b)  ; MARK x BOARD -> BOARD-list x Nat-list
  "Creat next poss boards for 'mark' m from board b, + list of poss moves"
  (let* ((remaining-moves (remove 'O (remove 'X b)))     ; example (2 5 6 8)
;         "use remaining-moves to make copies of board b, then insert m"
         (pre-boards   (mapcar #'(lambda (n) b) remaining-moves))
         (child-boards (mapcar #'(lambda (n b1) (substitute m n b1))
                                                           remaining-moves pre-boards))  )
         (list child-boards remaining-moves)  ) )

; test:   (poss-boards 'X *initial-board*)

; ----- TEST XTREE -----

; test:  (xtree 'X 'X *initial-node* 0)
; test:  (pprint (xtree 'X 'X *initial-node* 0))   ; one level deep for X
; test:  (pprint (xtree 'X 'X *initial-node* 5))   ; first wins for X

;;
;; ------------------------ TREE-BUILDING MINIMAX --------------------------
;;
;; --- This version of minimax rebuilds the tree, updated with
;; --- minimax scores and best move. (First found. Perhaps Random better?)

(defun txminimax (tree maxp)    ; TREE x Bool -> TREE
  "Traverses tree, rebuilds it using minimax with leaf-scores from xtree.
   We always start with tree root as maxplayer (maxp) = true as any
   player invoking this function always wants to win."
  (let* ( (n1       (tree-node tree))
             (minp     (not maxp))
             (ch1       (mapcar #'(lambda (tr) (txminimax tr minp)) (tree-children tree)) )
             (b1        (board n1))
             (move1  (cmove n1))
             (score1 (score n1))    )
    (cond  ((leafp tree) (mktree (mknode b1 move1 score1) ch1)  ) ; xtree leaf-score
           ( maxp   (mktree (mknode b1 move1 (tmax-child-value ch1)  ) ch1) )
           ( minp   (mktree (mknode b1 move1 (tmin-child-value ch1)  ) ch1) ) )
    ) )


(defun tmax-child-value (ch1)     ; TREE-list -> Nat
  " Finds the maximum score-value of the children of the root-node of tree"
  (apply #'max (mapcar #'(lambda (tr1) (score (tree-node tr1)))  ch1)  ) )

(defun tmin-child-value (ch1)    ; TREE-list -> Nat
  " Finds the minimum score-value of the children of the root-node of tree"
  (apply #'min (mapcar  #'(lambda (tr1) (score (tree-node tr1))) ch1)  ) )


;  test:  (pprint (txminimax (xtree 'X 'X *initial-node* 2) t) )


;; -------------------- GAME FRAMEWORK -----------------------------------
;;
;; The game is about boards, not nodes or trees. Those are purely internal
;; to tree-search players.
;;
;; The function 'play' takes functional arguments as players
;;

(defun play-game (m b p1 p2)   ; MARK x BOARD x PLAYER x PLAYER -> BOARD
  "This is the top-level function to play oxo, p1 plays first and so 'X'  "
  (cond ((is-win m b) (format t "Win for ~a~2%" m)   (print-board b))
           ((is-win (opp m) b) (format t "Win for ~a~2%" (opp m))   (print-board b))
           ((is-draw b)  (format t "It's a draw ~2%" ) (print-board b) )
           ( t    (format t "~%")
                  (let ((board1 (next-board m b p1)))
                  (play-game (opp m) board1 p2 p1)  )  ))  )

(defun next-board (m b p)  ; MARK x BOARD x PLAYER -> BOARD
  (print-board b)
  (let ((next (funcall p m b)))
    (substitute m next b) )  )

; ------------- HUMAN PLAYER --------------------------------

(defun human (m b)  ; (MARK x BOARD -> NAT) ...  aka type PLAYER
  (format t "~%")
  (format t "You play:  ~a~%" m)
  (print "Please enter an available number: ")
  (read) )

;  test:  (play-game 'X *initial-board* #'human #'human)

; ------------- RANDOM PLAYER --------------------------------

(defun rand-player (m b)   ; (MARK x BOARD -> NAT)
   (let* ((remaining-numbers (remove 'O (remove 'X b)))
          (n                 (length remaining-numbers))
          (random-index      (random n))  )
      (format t "~%")
      (format t "Rand is playing:  ~a~%" m)
      (sleep 2)
      (nth random-index remaining-numbers))  )

; test: (rand-player 'X *arbitrary*)
; test:  (play-game 'X *initial-board* #'human #'rand-player)
; test:  (play-game 'X *initial-board* #'rand-player #'human)

; ------------- MINIMAX PLAYER --------------------------------

(defvar *depth* 4)         ; minimax search depth

(defun mx-player-X (m b)  ; MARK x BOARD -> Nat    Plays X
    (mx-player 'X m b))

(defun mx-player-O (m b)  ; MARK x BOARD -> Nat    Plays O
    (mx-player 'O m b))

(defun mx-player (s m b)   ; (MARK x MARK x BOARD -> Nat)
   "Builds a game tree to *depth*, uses minimax for best move"
  (let* ((initial-node (mknode b 9 t) )
            (initial-tree (xtree s m initial-node *depth*))
            (mx-tree      (txminimax initial-tree t))  )
    (format t "~%")
    (format t "MX is playing:  ~a~2%" m)
    (if (< *depth* 4) (sleep 3) (sleep 1))
    (choose-mx-move mx-tree))  )


(defun choose-mx-move (tree)   ; TREE -> Nat
   (let* ( (n1  (tree-node tree))
              (ch1 (tree-children tree))
              (best-score  (score n1))
              (child-nodes (mapcar #'tree-node ch1))
              (move-score-pairs (mapcar 'cdr child-nodes)) )
      (first (find best-score move-score-pairs :key #'second))   ) )


; -----  TEST -----

; test:  (play-game 'X *initial-board* #'human #'mx-player-O)
; test:  (play-game 'X *initial-board* #'mx-player-X #'human)

#|
; ----------------- MINIMAX TESTING (Historical bug) --------------------

;  Bug: in b below, X plays 1 rather than 7. Easy win for O.

   (setf b '(X 1 2 3 X 5 O 7 O))     ;  -- X to play next
   (print-board b)

;     X | 1 | 2
;     3 | X | 5
;     O | 7 | O

   (setf n (mknode b 9 T))

   (setf initial-tree (xtree 'X 'X n *depth*))
   (pprint initial-tree)

   (setf mx-tree (txminimax initial-tree t))

   (setf mx-tree (txminimax (xtree 'X 'X (mknode b 9 T) *depth*) t) )

   (pprint mx-tree)
   (setf nodes (mapcar #'car (tree-children mx-tree)))
   (pprint nodes)

   (mx-player 'X 'X b)

   (choose-mx-move mx-tree)

   (play-game 'X b #'mx-player-X #'human)

; ------- test board this works correctly -----

   (setf b1 '(X 1 2 3 X O O X O))     ;  -- X to play next
   (print-board b1)
;
;     X | 1 | 2              -- X plays 1 and win. If X plays 2
;     3 | X | O              -- If O plays 3, X plays 1 and wins
;     O | X | O              -- so O will play 1 => draw
;
    (setf mx-tree1 (txminimax (xtree 'X 'X (mknode b1 9 T) *depth*) t) )
    (pprint mx-tree1)

|#

;---------------------------- END -----------------------------