Data commit

Task/Tic-tac-toe/Racket/tic-tac-toe-1.rkt

@@ -0,0 +1,20 @@
+#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))))))]))))

Task/Tic-tac-toe/Racket/tic-tac-toe-2.rkt

@@ -0,0 +1,109 @@
+#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))

Task/Tic-tac-toe/Racket/tic-tac-toe-3.rkt

@@ -0,0 +1,90 @@
+#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]))

Task/Tic-tac-toe/Racket/tic-tac-toe-4.rkt

@@ -0,0 +1,39 @@
+#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]))