Source code in the racket programming language

#lang lazy
(provide minimax)

(define (minimax tree)
  (! (let minimax ([node tree] [α -inf.0] [β +inf.0] [max-player #f])
       (cond 
         [(number? node) node]
         [(empty? node) 0.0]
         [max-player
          (let next ([x node] [α α])
            (if (or (empty? x) (<= β α)) 
                α
                (next (cdr x)
                      (max α (minimax (car x) α β (not max-player))))))]
         [else
          (let next ([x node] [β β])
            (if (or (empty? x) (<= β α)) 
                β
                (next (cdr x)
                      (min β (minimax (car x) α β (not max-player))))))]))))


#lang lazy
(require racket/class
         "minimax.rkt"
         (only-in racket/list shuffle argmax))

(provide game%
         interactive-player
         define-partners)

;;--------------------------------------------------------------------
;; Class representing the logics and optimal strategy 
;; for a zero-sum game with perfect information.
(define game%
  (class object%
    (super-new)
    
    ;; virtual methods which set up the game rules
    (init-field my-win?         ; State -> Bool
                my-loss?        ; State -> Bool
                draw-game?      ; State -> Bool
                my-move         ; State Move -> State
                opponent-move   ; State Move -> State
                possible-moves  ; State -> (list Move)
                show-state)     ; State -> Any
    
    ;; optimal-move :: State -> Move
    ;; Choses the optimal move. 
    ;; If several equivalent moves exist -- choses one randomly.
    (define/public ((optimal-move look-ahead) S)
      (! (argmax (λ (m) (! (minimax (game-tree S m look-ahead))))
                 (shuffle (possible-moves S)))))
    
    ;; game-tree :: State -> (Move -> (Treeof Real))
    (define (game-tree S m look-ahead)
      (let new-ply ([moves (cycle opponent-move my-move)] 
                    [i 1] 
                    [s (my-move S m)])
        (cond
          [(my-win? s)        (/  1 i)] ; more close wins and loses
          [(my-loss? s) (/ -1 i)] ; have bigger weights
          [(draw-game? s)     0]
          [(>= i look-ahead)  (/ 1 i)] 
          [else (map (λ (x) (new-ply (cdr moves) (+ 1 i) ((car moves) s x)))
                     (possible-moves s))])))
    
    ;; make-move :: State (State -> Move) -> (Move State Symbol)
    (define/public (make-move S move)
      (cond
        [(my-loss? S)   (values '() S 'loss)]         
        [(draw-game? S) (values '() S 'draw)]   
        [else (let* ([m* (! (move S))]
                     [S* (my-move S m*)])
                (cond
                  [(my-win? S*)    (values m* S* 'win)] 
                  [(draw-game? S*) (values m* S* 'draw)]
                  [else            (values m* S* 'next)]))]))))

;;--------------------------------------------------------------------
;; Mixin representing an interactive game player.
;; The parameter `game` defines a game which is played.
(define (interactive-player game)
  (class game
    (super-new)
    
    (inherit-field show-state)
    (inherit make-move optimal-move)
    
    (init-field name
                [look-ahead 4]
                [opponent 'undefined]
                [move-method (optimal-move look-ahead)])
    
    (define/public (your-turn S)
      (define-values (m S* status) (make-move S move-method))
      (! (printf "\n~a makes move ~a\n" name m))
      (! (show-state S*))
      (! (case status
           ['stop (displayln "The game was interrupted.")]
           ['win  (printf "~a wins!" name)]
           ['loss (printf "~a wins!" name)]
           ['draw (printf "Draw!")]
           [else (send opponent your-turn S*)])))))


;;--------------------------------------------------------------------
;; a simple macro for initialization of game partners
(define-syntax-rule 
  (define-partners game (A #:win A-wins #:move A-move) 
                        (B #:win B-wins #:move B-move))
  (begin
    (define A (class game 
                (super-new 
                 [my-win?  A-wins]
                 [my-loss? B-wins]
                 [my-move  A-move]
                 [opponent-move B-move])))
    (define B (class game 
                (super-new 
                 [my-win?  B-wins]
                 [my-loss? A-wins]
                 [my-move  B-move]
                 [opponent-move A-move])))))

;;--------------------------------------------------------------------
;; the main procedure which initiates the game
(define (start-game p1 p2 initial-state)
  (set-field! opponent p1 p2)
  (set-field! opponent p2 p1)
  (send p1 your-turn initial-state))


#lang racket

(require "game.rkt"
         racket/set
         lazy/force)

;;--------------------------------------------------------------------
;; Tick-tack-toe game implementation

;; the structure representing a board
(struct board (x o))

;; sets of X's and O's
(define xs board-x)
(define os board-o)

(define empty-board (board (set) (set)))

(define all-cells
  (set '(1 1) '(1 2) '(1 3)
       '(2 1) '(2 2) '(2 3)
       '(3 1) '(3 2) '(3 3)))

(define (free-cells b)
  (set-subtract all-cells (xs b) (os b)))

(define winning-positions
  (list (set '(1 1) '(2 2) '(3 3))
        (set '(1 3) '(2 2) '(3 1))
        (set '(1 1) '(1 2) '(1 3))
        (set '(2 1) '(2 2) '(2 3))
        (set '(3 1) '(3 2) '(3 3))
        (set '(1 1) '(2 1) '(3 1))
        (set '(1 2) '(2 2) '(3 2))
        (set '(1 3) '(2 3) '(3 3))))

;; a predicate for winning state on the board
(define ((wins? s) b)
  (ormap (curryr subset? (s b)) winning-positions))

;; player moves
(define (x-move b m)  (board (set-add (xs b) m) (os b)))
(define (o-move b m)  (board (xs b) (set-add (os b) m)))

;; textual representation of the board
(define (show-board b)
  (for ([i '(3 2 1)])
    (printf "~a " i)
    (for ([j '(1 2 3)])
      (display (cond
                 [(set-member? (os b) (list j i)) "|o"]
                 [(set-member? (xs b) (list j i)) "|x"]
                 [else "| "])))
    (display "|\n"))
  (display "   1 2 3    "))

;;--------------------------------------------------------------------
;; The definition of the game
;; general properties
(define tic-tac%
  (class game%
    (super-new
     [draw-game?       (compose set-empty? free-cells)]
     [possible-moves   (compose set->list free-cells)]
     [show-state       show-board])))

;; players
(define-partners tic-tac%
  (x% #:win (wins? xs) #:move x-move)
  (o% #:win (wins? os) #:move o-move))

;; Computer players
(define player-A (new (interactive-player x%) [name "A"] [look-ahead 6]))

(define player-B (new (interactive-player o%) [name "B"] [look-ahead 6]))

; The interactive user
(define User 
  (new (interactive-player x%) 
       [name "User"]
       [move-method 
        (λ (b) (let make-move ([m (read)])
                 (match m
                   ['q (exit)]
                   [(list (or 1 2 3) (or 1 2 3)) m]
                   [else (make-move (read))])))]))

;; The dummy player plays randomly
(define Dummy 
  (new (interactive-player o%) [name "Dummy"] [look-ahead 0]))


#lang racket

(require "game.rkt"
         lazy/force)

;;--------------------------------------------------------------------
;; The definition of the game

(define initial-state '(3 5 7))

(define (move s m) (map - s m))

(define (win? s) (= 1 (apply + s)))

(define (show-state s) (displayln (map (λ (n) (make-list n '●)) s)))

(define (possible-moves S)
  (append-map 
   (λ (heap n) 
     (map (λ (x) (map (curry * x) heap))
          (range 1 (+ 1 (min 3 n)))))
   '((1 0 0) (0 1 0) (0 0 1)) S))

(define Nim% (class game%
               (super-new
                [draw-game?       (const #f)]
                [possible-moves   possible-moves]
                [show-state       show-state])))

(define-partners Nim%
  (first%  #:win win? #:move move)
  (second% #:win win? #:move move))

;; players
(define player-A 
  (new (interactive-player first%) [name "A"] [look-ahead 4]))

(define player-B 
  (new (interactive-player second%) [name "B"] [look-ahead 4]))