Skip to content

Instantly share code, notes, and snippets.

@sorpaas
Last active May 15, 2019 11:54
Show Gist options
  • Star 3 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save sorpaas/ce833413a94077f045c4 to your computer and use it in GitHub Desktop.
Save sorpaas/ce833413a94077f045c4 to your computer and use it in GitHub Desktop.
A naive implementation of Tic Tac Toe written in miniKanren
title subtitle layout
Tic Tac Toe in miniKanren
Simple Good Old-Fashioned AI.
default

January 28, 2016

Nearly one year ago, I made a program called jing-logic. A tic-tac-toe game written in miniKanren. I remembered when a friend looked at the source codes, listening to me talking about the AI in it that you can play against with, "So you've already got an AI in this?" She asked, disbelieving that the AI part was so short that it was nearly nothing, even though the game was also simple.

I always regard that as a fun experiment, and in this post, I will introduce the game, the AI, as well as the source code.

The Language

The game was written in miniKanren, a logic programming language that is simple and fun to play with.

A logic program has two parts, some logic expressions, and a logic solver. Those logic expressions set up constraints about some logic variables. The logic solver is usually provided, and resolves those logic expressions to find possible assignments to those logic variables that satisfy those constraints.

In a "pure" miniKanren program, only several primitive constraints are provided. Using those primitive constraints, together with Lisp's define-lambda expression, you can create many complex constraints that represents anything that is computable (which means miniKanren is Turing-complete1). A special command run is provided to trigger the logic solver to compute the results. We tell, in run's parameters, about what logic variables we want to query.

The most fundamental operator is ==, or unify:

(run* (q)
  (== q 1))

The program prints out ((1)) representing that it can figure out one value that makes the program succeeds, that is q equals to 1.

Not all logic variables are for querying, so we have fresh, that creates an unexposed logic variable.

(run* (q)
  (fresh (p)
    (== p q)
    (== p 1)))

The final constraint is conde that represents logical disjunction (OR).

(run* (q)
  (conde
    ((== q 1))
    ((== q 2))))

The above program would return ((1) (2)). The logic solver can find two results that satisfy the constraints, that is q equaling 1 and q equaling 2.

As you may see, there's ==, fresh, conde, and run. That's nearly everything about miniKanren.

The Game

A tic-tac-toe game contains 9 positions in a 3x3 board. Two players (let's call them x and o) put piece on the board in turn. The first player that connects three pieces in a line no matter horizontally, vertically, or diagonally, wins.

So first let's define those two players:

(define (playero p)
  (conde ((== p 'o))
         ((== p 'x))))

A value in a board is either occupied by a player, or is nothing:

(define (valueo x)
  (conde ((playero x))
         ((nullo x))))

As for a board, there are 3 columns and 3 rows, so we use 1, 2, and 3 to represent those indexes.

(define (indexo x)
  (conde ((== x 1)) ((== x 2)) ((== x 3))))

Therefore we can define different positions in a board:

(define (positiono row column value board)
  (fresh (p11 p12 p13
          p21 p22 p23
          p31 p32 p33)
    (boardo p11 p12 p13
            p21 p22 p23
            p31 p32 p33 board)
    (conde
      ((== row 1) (== column 1) (== value p11))
      ((== row 1) (== column 2) (== value p12))
      ((== row 1) (== column 3) (== value p13))
      ((== row 2) (== column 1) (== value p21))
      ((== row 2) (== column 2) (== value p22))
      ((== row 2) (== column 3) (== value p23))
      ((== row 3) (== column 1) (== value p31))
      ((== row 3) (== column 2) (== value p32))
      ((== row 3) (== column 3) (== value p33)))))

By definition, horizontal positions are at the same row:

(define (horizontalo x y z board)
  (fresh (row)
    (indexo row)
    (positiono row 1 x board)
    (positiono row 2 y board)
    (positiono row 3 z board)))

And vertical positions are at the same column:

(define (verticalo x y z board)
  (fresh (column)
    (indexo column)
    (positiono 1 column x board)
    (positiono 2 column y board)
    (positiono 3 column z board)))

For diagonal positions, they are either, in order, '1 2 3' or '3, 2, 1'.

(define (diagonalo x y z board)
  (fresh (column-x column-y column-z)
    (conde
      ((== 1 column-x) (== 2 column-y) (== 3 column-z))
      ((== 3 column-x) (== 2 column-y) (== 1 column-z))
    (positiono 1 column-x x board)
    (positiono 2 column-y y board)
    (positiono 3 column-z z board)))

Now as we have all the necessary definition here, we can know the meaning of winner -- a player that occupies three pieces either horizontally, vertically, or diagonally.

(define (winnero player board)
  (playero player)
  (conde
    ((horizontalo player player player board))
    ((verticalo player player player board))
    ((diagonalo player player player board))))

Now if you execute (run* (board) (winnero 'o board)), the solver will output all possible board configurations that o is a winner.

The AI

The game is simple, as a result, there's a perfect strategy that a player can follow to never lose the game.

  1. Win: If the player has two in a row, they can place a third to get three in a row.
  2. Block: If the opponent has two in a row, the player must play the third themselves to block the opponent.
  3. Fork: Create an opportunity where the player has two threats to win (two non-blocked lines of 2).
  4. Blocking an opponent's fork (Option 1): The player should create two in a row to force the opponent into defending, as long as it doesn't result in them creating a fork. For example, if "X" has a corner, "O" has the center, and "X" has the opposite corner as well, "O" must not play a corner in order to win. (Playing a corner in this scenario creates a fork for "X" to win.)
  5. Blocking an opponent's fork (Option 2): If there is a configuration where the opponent can fork, the player should block that fork.
  6. Center: A player marks the center. (If it is the first move of the game, playing on a corner gives "O" more opportunities to make a mistake and may therefore be the better choice; however, it makes no difference between perfect players.)
  7. Opposite corner: If the opponent is in the corner, the player plays the opposite corner.
  8. Empty corner: The player plays in a corner square.
  9. Empty side: The player plays in a middle square on any of the 4 sides.

So we can implement that:

(define (strategy-wino player board move)
  (fresh (row column new-board)
    (moveo row column player move)
    (surpose-boardo board move new-board)
    (winnero player new-board)))

(define (strategy-blocko player board move)
  (fresh (opponent row column imaginary-opponent-move)
    (opponento player opponent)
    (strategy-wino opponent board imaginary-opponent-move)
    (moveo row column opponent imaginary-opponent-move)
    (moveo row column player move)))

(define (strategy-randomo player board move)
  (fresh (row column next-board)
    (moveo row column player move)
    (surpose-boardo board move next-board)))

And create an AI player:

(define (ai-playo player current-board next-board)
  (conda
    ((full-boardo current-board) (== current-board next-board))
    ((fresh (move)
       (surpose-boardo current-board move next-board)
       (conda
         ((strategy-wino player current-board move))
         ((strategy-blocko player current-board move))
         ((strategy-randomo player current-board move)))))))

Footnotes

  1. We don't consider optimization here. Using those primitive constraints, everything is computable, but probably not fast.

#lang cKanren
(require cKanren/miniKanren)
; A tic-tac-toe game contains 9 positions, each position can be
; either 'x, 'o, or null. We first define all values that can
; exist in a board.
(define (playero p)
(conde ((== p 'o)) ((== p 'x))))
(define (valueo x)
(conde ((playero x)) ((nullo x))))
(define (boardo p11 p12 p13 p21 p22 p23 p31 p32 p33 board)
(== (list p11 p12 p13 p21 p22 p23 p31 p32 p33) board))
; We use 1, 2 and 3 to represent each column and row in a board.
; We won't use indexo and valueo really often since it will makes
; our program slow.
(define (indexo x)
(conde ((== x 1)) ((== x 2)) ((== x 3))))
; Combining a pair of column-row, we are able to represent a
; position in a board.
(define (positiono row column value board)
(fresh (p11 p12 p13 p21 p22 p23 p31 p32 p33)
(boardo p11 p12 p13 p21 p22 p23 p31 p32 p33 board)
(conde
((== row 1) (== column 1) (== value p11))
((== row 1) (== column 2) (== value p12))
((== row 1) (== column 3) (== value p13))
((== row 2) (== column 1) (== value p21))
((== row 2) (== column 2) (== value p22))
((== row 2) (== column 3) (== value p23))
((== row 3) (== column 1) (== value p31))
((== row 3) (== column 2) (== value p32))
((== row 3) (== column 3) (== value p33)))))
; We define the meaning of "vertical" and "horizontal".
(define (horizontalo x y z board)
(fresh (row)
(indexo row)
(positiono row 1 x board)
(positiono row 2 y board)
(positiono row 3 z board)))
(define (verticalo x y z board)
(fresh (column)
(indexo column)
(positiono 1 column x board)
(positiono 2 column y board)
(positiono 3 column z board)))
; Before we come to diagonal, we need to know the meaning of
; symmetric.
(define (symmetric-indexo a b)
(conde
((== a 1) (== b 3))
((== a 2) (== b 2))
((== a 3) (== b 1))))
; Now we can define diagonal. The row can be assigned 1, 2 and 3
; in order, but there are two possiblities for columns.
(define (diagonalo x y z board)
(fresh (column-x column-y column-z)
(conde
((== 1 column-x) (== 2 column-y)
(== 3 column-z))
((symmetric-indexo 1 column-x) (symmetric-indexo 2 column-y)
(symmetric-indexo 3 column-z)))
(positiono 1 column-x x board)
(positiono 2 column-y y board)
(positiono 3 column-z z board)))
; It's time for us to know how one can win the game.
(define (winnero player board)
(playero player)
(conde
((horizontalo player player player board))
((verticalo player player player board))
((diagonalo player player player board))))
; Time to have some fun: (run* (board) (winnero 'o board))
; ---
; There are three special types of board: an blank board, a board
; with a single placement, and a full board. An blank board is a
; special type of an blank list, which we define first.
(define (blanko x)
(conde
((nullo x))
((fresh (car-x cdr-x)
(conso car-x cdr-x x)
(nullo car-x)
(blanko cdr-x)))))
; There seems to be some bugs in cKanren (or I have some misunder-
; standings of it). Change the above code "conde" to "conda", when
; running "(run* (x) (blanko x)", there's only one item in the
; list: "()". However, "(run* (q) (blanko '(() ())) (== q #t))"
; returns (#t).
(define (blank-boardo x)
(boardo '(() () () () () () () () ()) x))
; It can also be written as
; (define (blank-boardo x)
; (fresh (p11 p12 p13 p21 p22 p23 p31 p32 p33)
; (blanko x)
; (boardo p11 p12 p13 p21 p22 p23 p31 p32 p33 x)))
; But slower, and it never returns when asking for all possibilities.
; Now let's define a board with a single item.
(define (singleton-listo x)
(fresh (car-x cdr-x)
(conso car-x cdr-x x)
(conde
((playero car-x) (blanko cdr-x))
((nullo car-x) (singleton-listo cdr-x)))))
(define (null8o q1 q2 q3 q4 q5 q6 q7 q8)
(fresh ()
(nullo q1) (nullo q2) (nullo q3) (nullo q4)
(nullo q5) (nullo q6) (nullo q7) (nullo q8)))
; Sadly, miniKanren cannot express for-all (yet?)
(define (singleton-boardo x)
(fresh (p11 p12 p13 p21 p22 p23 p31 p32 p33)
(boardo p11 p12 p13 p21 p22 p23 p31 p32 p33 x)
(conde
((playero p11) (null8o p12 p13 p21 p22 p23 p31 p32 p33))
((playero p12) (null8o p11 p13 p21 p22 p23 p31 p32 p33))
((playero p13) (null8o p11 p12 p21 p22 p23 p31 p32 p33))
((playero p21) (null8o p11 p12 p13 p22 p23 p31 p32 p33))
((playero p22) (null8o p11 p12 p13 p21 p23 p31 p32 p33))
((playero p23) (null8o p11 p12 p13 p21 p22 p31 p32 p33))
((playero p31) (null8o p11 p12 p13 p21 p22 p23 p32 p33))
((playero p32) (null8o p11 p12 p13 p21 p22 p23 p31 p33))
((playero p33) (null8o p11 p12 p13 p21 p22 p23 p31 p32)))))
; It can also be written as
; (define (singleton-boardo x)
; (fresh (p11 p12 p13 p21 p22 p23 p31 p32 p33)
; (singleton-listo x)
; (boardo p11 p12 p13 p21 p22 p23 p31 p32 p33 x)))
; But slower, and it never returns when asking for all possibilities.
; A unsolved problem here: run* won't return, we should use
; run 1 or whatever number I want.
; ---
; Finally a full board
(define (full-listo x)
(conde
((nullo x))
((fresh (car-x cdr-x)
(conso car-x cdr-x x)
(playero car-x)
(full-listo cdr-x)))))
(define (full-boardo x)
(fresh (p11 p12 p13 p21 p22 p23 p31 p32 p33)
(boardo p11 p12 p13 p21 p22 p23 p31 p32 p33 x)
(playero p11) (playero p12) (playero p13)
(playero p21) (playero p22) (playero p23)
(playero p31) (playero p32) (playero p33)))
; It can also be written as
; (define (full-boardo x)
; (fresh (p11 p12 p13 p21 p22 p23 p31 p32 p33)
; (full-listo x)
; (boardo p11 p12 p13 p21 p22 p23 p31 p32 p33 x)))
; But slower, and it never returns when asking for all possibilities.
; Here we can define a move using the singleton-board.
(define (moveo row column player board)
(fresh ()
(playero player)
(singleton-boardo board)
(positiono row column player board)))
; We surpose a board to another board to get a new board.
(define (surpose-valueo a b c)
(conde
((nullo a) (nullo b) (nullo c))
((nullo a) (playero b) (== b c))
((playero a) (nullo b) (== a c))))
(define (surpose-listo a b c)
(conde
((nullo a) (nullo b) (nullo c))
((fresh (cara cdra carb cdrb carc cdrc)
(conso cara cdra a) ; Make sure a is not null, and so on
(conso carb cdrb b)
(conso carc cdrc c)
(surpose-valueo cara carb carc)
(surpose-listo cdra cdrb cdrc)))))
(define (surpose-boardo a b c)
(fresh (a11 a12 a13 a21 a22 a23 a31 a32 a33
b11 b12 b13 b21 b22 b23 b31 b32 b33
c11 c12 c13 c21 c22 c23 c31 c32 c33)
(boardo b11 b12 b13 b21 b22 b23 b31 b32 b33 b)
(boardo a11 a12 a13 a21 a22 a23 a31 a32 a33 a)
(boardo c11 c12 c13 c21 c22 c23 c31 c32 c33 c)
(surpose-valueo a11 b11 c11) (surpose-valueo a12 b12 c12) (surpose-valueo a13 b13 c13)
(surpose-valueo a21 b21 c21) (surpose-valueo a22 b22 c22) (surpose-valueo a23 b23 c23)
(surpose-valueo a31 b31 c31) (surpose-valueo a32 b32 c32) (surpose-valueo a33 b33 c33)))
; It can also be written as
; (define (surpose-boardo a b c)
; (fresh (a11 a12 a13 a21 a22 a23 a31 a32 a33
; b11 b12 b13 b21 b22 b23 b31 b32 b33
; c11 c12 c13 c21 c22 c23 c31 c32 c33)
; (boardo b11 b12 b13 b21 b22 b23 b31 b32 b33 b)
; (boardo a11 a12 a13 a21 a22 a23 a31 a32 a33 a)
; (boardo c11 c12 c13 c21 c22 c23 c31 c32 c33 c)
; (surpose-listo a b c)))
; Finally, we consider the situation when a user plays the game.
; We first transform the game state to something that the UI can
; understand.
(define (string-playero player str)
(conde
((== player 'o) (== str "o"))
((== player 'x) (== str "x"))
((nullo player) (== str "_"))))
; This is the only recursive relation. It never returns when
; running "run*", but since it's only used in user-playo, so
; it seems to be OK.
(define (string-boardo board str-board)
(conde
((nullo board) (nullo str-board))
((fresh (car-board cdr-board car-str-board cdr-str-board)
(conso car-board cdr-board board)
(conso car-str-board cdr-str-board str-board)
(string-playero car-board car-str-board)
(string-boardo cdr-board cdr-str-board)))))
; We let a user to play it.
(define (user-playo current-user-player current-board move-row move-column
next-user-player next-board buttons msg done)
(fresh (move winner middle-board)
(moveo move-row move-column current-user-player move)
(surpose-boardo current-board move next-board) ;middle-board)
;(ai-playo 'o middle-board next-board)
(string-boardo next-board buttons)
(conde
((== current-user-player 'o) (== next-user-player 'x))
((== current-user-player 'x) (== next-user-player 'o))) ;'x)))
(conda
((winnero 'o next-board) (== msg "Player o has won the game. ")
(== done #t))
((winnero 'x next-board) (== msg "Player x has won the game. ")
(== done #t))
((full-boardo next-board) (== msg "A draw game. ")
(== done #t))
((nullo winner)
(== done #f)
(conde
((== next-user-player 'o)
(== msg "Nice move. Player o's turn. "))
((== next-user-player 'x)
(== msg "Nice move. Player x's turn. ")))))))
; Some AI helper functions for writting the strategy. It's based
; on Wikipedia:Tic-tac-toe#Strategy.
(define (opponento p q)
(conde
((== p 'o) (== q 'x))
((== p 'x) (== q 'o))))
; Win: If the player has two in a row, they can place a third to
; get three in a row.
(define (strategy-wino player board move)
(fresh (row column new-board)
(moveo row column player move)
(surpose-boardo board move new-board)
(winnero player new-board)))
; Block: If the opponent has two in a row, the player must play
; the third themselves to block the opponent.
(define (strategy-blocko player board move)
(fresh (opponent row column imaginary-opponent-move)
(opponento player opponent)
(strategy-wino opponent board imaginary-opponent-move)
(moveo row column opponent imaginary-opponent-move)
(moveo row column player move)))
; miniKanren cannot deal with random things, so we pretend this
; is random.
(define (strategy-randomo player board move)
(fresh (row column next-board)
(moveo row column player move)
(surpose-boardo board move next-board)))
; And so on ...
(define (ai-playo player current-board next-board)
(conda
((full-boardo current-board) (== current-board next-board))
((fresh (move)
(surpose-boardo current-board move next-board)
(conda
((strategy-wino player current-board move))
((strategy-blocko player current-board move))
((strategy-randomo player current-board move)))))))
;;; The following are supplemental codes that create and refresh
;;; The GUI.
; The Interface
(require (prefix-in r/ racket))
(require (prefix-in g/ racket/gui))
; The game states
(define ui-current-board '(() () ()
() () ()
() () ()))
(define ui-current-player 'x)
; Layout
(define (ui-create-board-button row column p)
(r/new g/button%
[parent p]
[label "_"]
[callback (lambda (b e)
(ui-play row column))]))
(define ui-frame (r/new g/frame% [label "Jing Game"]))
(define ui-msg (r/new g/message% [parent ui-frame]
[label "No events so far ..."]
[auto-resize #t]))
(define ui-board-panel (r/new g/horizontal-panel%
[parent ui-frame]
[alignment '(center center)]))
(define ui-board-row-1 (r/new g/vertical-panel%
[parent ui-board-panel]))
(define ui-board-row-2 (r/new g/vertical-panel%
[parent ui-board-panel]))
(define ui-board-row-3 (r/new g/vertical-panel%
[parent ui-board-panel]))
(define ui-board-buttons (list
(ui-create-board-button 1 1 ui-board-row-1)
(ui-create-board-button 1 2 ui-board-row-1)
(ui-create-board-button 1 3 ui-board-row-1)
(ui-create-board-button 2 1 ui-board-row-2)
(ui-create-board-button 2 2 ui-board-row-2)
(ui-create-board-button 2 3 ui-board-row-2)
(ui-create-board-button 3 1 ui-board-row-3)
(ui-create-board-button 3 2 ui-board-row-3)
(ui-create-board-button 3 3 ui-board-row-3)))
; Play the game
(define (ui-refresh-buttons button-strs buttons)
(cond
[(null? button-strs) (void)]
[else (begin
(g/send (car buttons) set-label (car button-strs))
(ui-refresh-buttons (cdr button-strs) (cdr buttons)))]))
(define (ui-play row column)
(let ([next-states (run 1 (next-user-player
next-board
buttons
msg
done)
(user-playo ui-current-player
ui-current-board
row
column
next-user-player
next-board
buttons
msg
done))])
(if (null? next-states)
(g/send ui-msg set-label "Cannot resolve that move.")
(let* ([state (car next-states)]
[next-user-player (list-ref state 0)]
[next-board (list-ref state 1)]
[buttons (list-ref state 2)]
[msg (list-ref state 3)]
[done (list-ref state 4)])
(set! ui-current-player next-user-player)
(set! ui-current-board next-board)
(ui-refresh-buttons buttons ui-board-buttons)
(g/send ui-msg set-label msg)
(if done
(for ([btn ui-board-buttons])
(g/send btn enable #f))
(void))))))
; Show frame
(g/send ui-frame show #t)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment