Land of LISP and Lazy Evaluation

One of my recent read was “Land of LISP” by Conrad Barski. It’s an unconventional programming book, packed with comics. Most examples are tiny games you can code in a couple of pages. I personally liked the book a lot, it is fun to read and presents a language that, in my opinion, is also fun.

My experience with LISP is quite limited, so most of the things I found in the book were new to me (I knew how to define functions and basic stuff, but nothing about macros, only a couple of built-in functions, etc.). One of the things I liked the most was one of the examples for macros where the author presents a simple solution to get lazy evaluation. In the book, the author codes a game with some weird rules, and I don’t think I would learn much by just copying that example, therefore, I will use the same idea here but with our old friend tic-tac-toe. I have to warn you that the implementation I’m going to post is not a good tic-tac-toe implementation, you can probably find more challenging opponents. The main goal of this exercise is to illustrate the lazy evaluation. Having said that, lets get started.

The board

I’ll define the board as an array, if the game is a tic-tac-toe of \(ntimes x\), then this array will contain \(n^2+1\) elements. The first position will store \(n\); the next \(n\) positions will represent the first row, the next \(n\) positions the second row, and so on. The elements in the board may have 3 different values:

• 0 for a position that hasn’t been played
• 1 for a position played by the user
• 2 for positions played by the computer

Next I include five functions we will use to manage the board.

(defun new-board (n)
  (map 'array (lambda (x) x)
       (cons n (loop as x from 1 to (* n n) collect 0))))

(defun copy-board (board)
  (map 'array (lambda (x) x) (loop for i across board collect i)))

(defun same-board? (b1 b2)
  (let ((l (min (aref b1 0) (aref b2 0))))
    (reduce (lambda (x y) (and x y))
        (mapcar
         (lambda (x) (= (aref b1 x) (aref b2 x)))
         (loop for i from 0 to (* l l) collect i))
        :initial-value t)))

(defun board-full? (board)
  (= 0 (array-dimension (remove-if-not (lambda (x) (= x 0)) board) 0)))

(defun map-to-array-position (board x y)
  (let ((n (aref board 0)))
    (1+ (+ (* n x) y))))

The first function is for creating a board. The second allows you to create a copy of a board. The third function compares two boards. The fourth one checks whether a board is full, that is, there aren’t any more positions where a player could play. Finally, since we are storing the elements in a linear array, we include a function to map \((x,y)\) coordinates to its corresponding position.

Now, I include the functions to play a given position and also for checking whether a position is valid for playing or not.

(defun play-position (board x y player)
  (let* ((new-board (copy-board board)))
    (setf (aref new-board (map-to-array-position board x y)) player)
    new-board))

(defun can-play? (board x y)
  (and (< x (aref board 0)) (< y (aref board 0))
       (equal (aref board (map-to-array-position board x y)) 0)))

Now we only need a function to check whether someone won the game. To do so, I’ll define the function all-same-player that takes in a board, a list of positions, and a player. This function determines whether that player appears in all positions in the list. Using all-same-player we can implement the rest easily:

(defun all-same-player (board posns player)
  (= (list-length posns)
     (list-length
      (remove-if-not
       (lambda (x)
     (equal player
        (aref board (map-to-array-position board (car x) (cadr x)))))
       posns))))

(defun check-column (board x player)
  (let ((n (aref board 0)))
    (all-same-player board
             (loop for i from 0 to (1- n) collect (list i x))
             player)))

(defun check-row (board x player)
  (let ((n (aref board 0)))
    (all-same-player board
             (loop for i from 0 to (1- n) collect (list x i))
             player)))

(defun check-rows (board player)
  (let ((n (aref board 0)))
    (reduce (lambda (x y) (or x y))
       (loop for i from 0 to (1- n) collect
         (check-row board i player)))))

(defun check-columns (board player)
  (let ((n (aref board 0)))
    (reduce (lambda (x y) (or x y))
       (loop for i from 0 to (1- n) collect
         (check-column board i player)))))

(defun check-diagonals (board player)
  (let ((n (aref board 0)))
    (or
     (all-same-player board
              (loop for i from 0 to (1- n) collect
                (list i i))
              player)
     (all-same-player board
              (loop for i from 0 to (1- n) collect
                (list (- n (1+ i)) i))
              player))))

(defun is-winner (board player)
  (or
   (check-diagonals board player)
   (check-columns board player)
   (check-rows board player)))

(defun compute-winner (board)
  (cond
   ((is-winner board 1) 1)
   ((is-winner board 2) 2)
   (t 0)))

Finally, our last helper functions will show the board, that way, we can see what’s going on.

(defun show-row (board row)
  (let ((n (aref board 0)))
    (loop for i from 0 to (1- n) do
      (progn
        (let ((val (aref board (map-to-array-position board row i))))
          (cond
           ((= 0 val) (princ #-))
           ((= 1 val) (princ #X))
           (t (princ #O))))))))

(defun show-board (board)
  (let ((n (aref board 0)))
    (loop for i from 0 to (1- n) do
      (progn
        (fresh-line)
        (show-row board i)))
    (fresh-line)))

The tree representing all possible games

We will start coding a simple version not using lazy-evaluation. To do so, we will just compute all possible games and store them in a tree. The tree is represented as nested lists, a node corresponds to a board and a list of possible configurations that follow after one move of the current player’s turn. In our case, the starting player will always be the user (however, the code for building the tree does not make use of that assumption).

(defun build-tree (board player)
  (let* ((n (aref board 0))
     (posns (loop as x from 0 to (1- (* n n))
              collect (list (floor (/ x n)) (rem x n))))
     (valid-posns (remove-if-not
               (lambda (x) (can-play? board (car x) (cadr x)))
               posns)))
    (if (or (not valid-posns) (< 0 (compute-winner board)))
    (list board)
      (cons board (list
           (mapcar (lambda (i)
                  (build-tree
                    (play-position board
                           (car i)
                           (cadr i)
                           player)
                    (1+ (rem player 2))))
                 valid-posns))))))

Our code will use this tree and subtrees to represent the state of the game. We do this by defining a global variable named *game*. This variable stores the current state of the game (at the beginning, the whole tree).

(defparameter *game* (build-tree (new-board 4) 1) 

First AI

Our first AI implementation uses the tree that pre-computes everything. We will compute a score for every possible move (i.e., path we could take in the tree), assuming that the user is going the play the best possible way up to the level we are considering, defined as *max-depth*. The computer will chose the move that maximizes this score.

(defun score-board (board player)
  (let ((winner (compute-winner board)))
    (cond
     ((= winner player) 2)
     ((= winner 0) 0)
     (t -1000))))

(defparameter *max-depth* 4)

(defun score-node (node player)
  (labels ((f (actual)
          (if (= player actual) 10000 -10000))
       (score-node-maxd (n actual d)
        (if (or (= *max-depth* d) (= 1 (list-length n)))
        (progn
          (score-board (car n) player))
          (reduce (lambda (x y)
            (if (= player actual) (min x y) (max x y)))
              (mapcar (lambda (x)
                (score-node-maxd
                 x
                 (1+ (rem actual 2))
                 (1+ d)))
                  (cadr n))
              :initial-value (f actual)))))
    (score-node-maxd node player 0)))

(defun play-ai (tree)
  (let ((scores (mapcar (lambda (x)
              (score-node  x 2))
            (cadr tree))))
    (cond
     ((= (list-length scores) 0) '())
     ((= (list-length scores) 1) (caadr tree))
     (t (let ((best (apply #'max scores)))
      (car (remove-if-not (lambda (x) (= best (score-node x 2)))
                  (cadr tree))))))))

A Terrible Interface

The next snippet shows how to implement the function play-human. This is the function we’ll use to try this game using the REPL provided by clisp.

(defun play-human (x y)
  (let ((board (car *game*)))
    (if (or (board-full? board) (= (list-length (cdr *game*)) 0))
    "Game over, no winner"
      (if (not (can-play? board x y))
      "No winner, the game is over or your move is ilegal"
    (let ((tmp-board (play-position board x y 1)))
      (if (= 1 (compute-winner tmp-board))
          (progn
        (setf *game* (list tmp-board))
        (show-board tmp-board)
        "You win, congratulations")
        (if (board-full? tmp-board)
        "Game over, no winner"
          (progn
        (setf *game*
              (play-ai
                  (car
                   (remove-if-not
                (lambda (x)
                  (same-board? (car x) tmp-board))
                (cadr *game*)))))
        (if *game*
            (progn
              (show-board (car *game*))
              (if (= (compute-winner (car *game*)) 2)
              (print "Computer wins!")))
          (print "To restart set *game* again"))))))))))

Playing the game

Here is the result for a grid of \(3 time 3\) when executing the code inside the REPL:

[1]> (time (load "tic-tac-toe.lisp"))
;; Loading file tic-tac-toe.lisp ...
;; Loaded file tic-tac-toe.lisp
Real time: 162.33704 sec.
Run time: 162.18 sec.
Space: 5961074744 Bytes
GC: 946, GC time: 9.41 sec.
T
[2]> (time (play-human 0 1))
OX-
---
---
Real time: 3.853072 sec.
Run time: 3.84 sec.
Space: 158411920 Bytes
GC: 9, GC time: 0.27 sec.
NIL
[3]> (time (play-human 1 1))
OX-
-X-
-O-
Real time: 0.271333 sec.
Run time: 0.26 sec.
Space: 10360592 Bytes
GC: 1, GC time: 0.03 sec.
NIL
[4]> (time (play-human 0 2))
OXX
-X-
OO-
Real time: 0.017993 sec.
Run time: 0.02 sec.
Space: 396496 Bytes
NIL
[5]> (time (play-human 2 2))
OXX
OX-
OOX

"Computer wins!"
Real time: 0.0057 sec.
Run time: 0.01 sec.
Space: 85496 Bytes

As expected, loading the code is slow, since it pre-computes all possible games for a \(3times 3\) grid. Our next step will be to introduce lazy evaluators in the construction of the tree in order to make the initial step faster. This will also allow us to play on bigger grids too.

Lazy Evaluators

The solution proposed in “Land of LISP” requires two constructs. First, a macro called lazy, and second, a function called force. The macro creates a lambda function that contains enough information to evaluate something that was passed to lazy. The force function forces the evaluation of the lambda function generated by lazy. As one would desire, this evaluation happens only once, after that, the value is stored and we just look it up. Here is the code (extracted from the book):

(defmacro lazy (&body body)
  (let ((forced (gensym))
    (value (gensym)))
    `(let ((,forced nil)
       (,value nil))
       (lambda ()
     (unless ,forced
       (setf ,value (progn ,@body))
       (setf ,forced t))
     ,value))))

(defun force (lazy-value)
  (funcall lazy-value))

Now, using this, we have to modify the construction of our tree. We will assume that the root of the tree is partially computed: we have access to the current state of the board but the states reachable in one move from there are not yet computed. The code looks like this:

(defun build-tree (board player)
  (let* ((n (aref board 0))
     (posns (loop as x from 0 to (1- (* n n))
              collect (list (floor (/ x n)) (rem x n))))
     (valid-posns (remove-if-not
               (lambda (x) (can-play? board (car x) (cadr x)))
               posns)))
    (if (or (not valid-posns) (< 0 (compute-winner board)))
    (list board)
      (cons board (list
           (mapcar (lambda (i)
                 (lazy (build-tree
                    (play-position board
                           (car i)
                           (cadr i)
                           player)
                    (1+ (rem player 2)))))
                 valid-posns))))))

This is very similar to our previous function, we just added some calls to lazy where we needed them and now the code is not pre-computing everything :-). In order to finish the implementation, we need to update the functions that use the tree and make them call the force function when we are accessing the list of reachable states:

(defun score-node (node player)
  (labels ((f (actual)
          (if (= player actual) 10000 -10000))
       (score-node-maxd (n actual d)
        (if (or (= *max-depth* d) (= 1 (list-length n)))
        (progn
          (score-board (car n) player))
          (reduce (lambda (x y)
            (if (= player actual) (min x y) (max x y)))
              (mapcar (lambda (x)
                (score-node-maxd
                 (force x)
                 (1+ (rem actual 2))
                 (1+ d)))
                  (cadr n))
              :initial-value (f actual)))))
    (score-node-maxd node player 0)))
(defun play-ai (tree)
  (let ((scores (mapcar (lambda (x)
              (score-node (force x) 2))
            (cadr (force tree)))))
    (cond
     ((= (list-length scores) 0) '())
     ((= (list-length scores) 1) (force (caadr (force tree))))
     (t (let ((best (apply #'max scores)))
      (car (remove-if-not (lambda (x) (= best (score-node (force x) 2)))
                  (cadr (force tree)))))))))

(defun play-human (x y)
  (let ((board (car *game*)))
    (if (or (board-full? board) (= (list-length (cdr *game*)) 0))
    "Game over, no winner"
      (if (not (can-play? board x y))
      "No winner, the game is over or your move is ilegal"
    (let ((tmp-board (play-position board x y 1)))
      (if (= 1 (compute-winner tmp-board))
          (progn
        (setf *game* (list tmp-board))
        (show-board tmp-board)
        "You win, congratulations")
        (if (board-full? tmp-board)
        "Game over, no winner"
          (progn
        (setf *game*
              (force (play-ai
                  (car
                   (remove-if-not
                (lambda (x)
                  (same-board? (car (force x)) tmp-board))
                (cadr *game*))))))
        (if *game*
            (progn
              (show-board (car *game*))
              (if (= (compute-winner (car *game*)) 2)
              (print "Computer wins!")))
          (print "To restart set *game* again"))))))))))

And that’s it. The code looks pretty similar to what we had before. So lets try it:

[1]> (time (load "tic-tac-toe-lazy.lisp"))
;; Loading file tic-tac-toe-lazy.lisp ...
;; Loaded file tic-tac-toe-lazy.lisp
Real time: 0.005814 sec.
Run time: 0.0 sec.
Space: 269912 Bytes
T
[2]> (time (play-human 0 1))
OX-
---
---
Real time: 9.12025 sec.
Run time: 9.11 sec.
Space: 292923384 Bytes
GC: 102, GC time: 0.85 sec.
NIL
[3]> (time (play-human 1 1))
OX-
-X-
-O-
Real time: 0.567565 sec.
Run time: 0.56 sec.
Space: 19241920 Bytes
GC: 4, GC time: 0.01 sec.
NIL
[4]> (time (play-human 1 0))
OX-
XXO
-O-
Real time: 0.012457 sec.
Run time: 0.01 sec.
Space: 487392 Bytes
NIL
[5]> (time (play-human 0 2))
OXX
XXO
OO-
Real time: 0.00496 sec.
Run time: 0.0 sec.
Space: 72096 Bytes
NIL
[6]> (time (play-human 2 2))
Real time: 0.001211 sec.
Run time: 0.0 sec.
Space: 14296 Bytes
"Game over, no winner"

This is faster than the previous one, but has the disadvantage that it now takes longer between turns, whereas before we could play at a good speed given that we waited for the program to start. If we increase \(n\) to be 4, we can still play. Here is one example using the compiled code:

;; Loading file tic-tac-toe-lazy.fas ...
;; Loaded file tic-tac-toe-lazy.fas
[1]> *max-depth*
4
[2]> (time (play-human 2 2))
O---
----
--X-
----
Real time: 119.11944 sec.
Run time: 118.99 sec.
Space: 8910421024 Bytes
GC: 179, GC time: 27.23 sec.
NIL
[3]> (time (play-human 1 2))
OO--
--X-
--X-
----
Real time: 53.819393 sec.
Run time: 53.74 sec.
Space: 3758271784 Bytes
GC: 56, GC time: 10.61 sec.
NIL
[4]> (time (play-human 0 2))
OOX-
--X-
--X-
--O-
Real time: 15.362058 sec.
Run time: 15.34 sec.
Space: 1125757384 Bytes
GC: 18, GC time: 2.67 sec.
NIL
[5]> (time (play-human 2 3))
OOXO
--X-
--XX
--O-
Real time: 4.659082 sec.
Run time: 4.65 sec.
Space: 365641080 Bytes
GC: 14, GC time: 0.63 sec.
NIL
[6]> (time (play-human 2 1))
OOXO
--X-
OXXX
--O-
Real time: 0.677717 sec.
Run time: 0.67 sec.
Space: 47792728 Bytes
GC: 2, GC time: 0.14 sec.
NIL
[7]> (time (play-human 1 0))
OOXO
XOX-
OXXX
--O-
Real time: 0.04237 sec.
Run time: 0.04 sec.
Space: 2880760 Bytes

I also tried building the tree for the \(4times 4\) grid without using lazy evaluation, but I gave up after waiting 30 minutes. The advantage of the lazy evaluation comes from the fact that the computer is not actually evaluating all possibilities to make the move, we are limiting the depth we check. If we were not doing this, then we would not see much difference between both solutions.

Things I’m not considering

I didn’t try to optimize the solution in any way, this is just meant to be an example of lazy evaluation. I’m sure the tic-tac-toe version shown here could be improved in many ways. I’m also not an expert LISP programmer; in fact, I’m a beginner in this language, so even if I tried to optimize, I would possibly obtain a sub-optimal solution (or mess more things up :p). Some things that could help are:

• Using hash-tables for the states.
• Avoiding some repetitions. There are things I’m computing twice because it was easier. Probably someone with experience would see easy ways of avoiding those things without complicating the code.

If you have any suggestions for improving this code, I would be happy to hear about it.

If you want to see more examples of lazy evaluations, you can take a look a this article by Alex Bowe most of the examples are in Python.