suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

games/gobblet: fix game explorer in case of tie

Browse Source 
A tie due to a cycle would cause the explorer to fail instead of
giving up with a tie.
This commit is contained in:
Matthew Flatt 2014-07-08 08:44:37 +01:00
parent 2efb053a4c
commit f1c6b52284
2 changed files with 50 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
pkgs/games/gobblet/explore.rkt
View File

@ -98,7 +98,8 @@
(unless (or (and (= steps max-steps) (unless (or (and (= steps max-steps)
(one-step-depth . <= . max-depth)) (one-step-depth . <= . max-depth))
((car result) . = . +inf.0) ((car result) . = . +inf.0)
((car result) . = . -inf.0)) ((car result) . = . -inf.0)
((cdr result) . eq? . 'loop!))
(if (one-step-depth . <= . max-depth) (if (one-step-depth . <= . max-depth)
(loop (add1 steps) 2) (loop (add1 steps) 2)
(loop steps (add1 max-depth))))) (loop steps (add1 max-depth)))))
@ -249,7 +250,7 @@
[key (vector board-key (- (config-max-depth config) depth) span)]) [key (vector board-key (- (config-max-depth config) depth) span)])
(let ([choices (let ([choices
(cond (cond
;; Check for known win/loss at arbitrary depth: ;; Check for known win/loss/tie at arbitrary depth:
[(hash-ref (config-memory config) board-key (lambda () #f)) [(hash-ref (config-memory config) board-key (lambda () #f))
=> (lambda (x) x)] => (lambda (x) x)]
;; Check for known result at specific remaining depth: ;; Check for known result at specific remaining depth:
@ -504,36 +505,46 @@
(= steps 1)) (= steps 1))
(record-result plays board me config init-memory)) (record-result plays board me config init-memory))
(if (or (steps . <= . 1) first-move?) (cond
(first plays) [(null? plays)
(let ([nexts ;; No moves because it was a tie due to a repeat.
;; See what the other player thinks about our candidate moves, (car LOOP-TIE)]
;; and pick the one that looks worst to the other player. [(or (steps . <= . 1) first-move?)
(if ((caar plays) . < . +inf.0) (first plays)]
(sort [else
(map (let ([nexts
(lambda (play) ;; See what the other player thinks about our candidate moves,
(log-printf 4 indent " ~a>>> Checking: ~a\n" ;; and pick the one that looks worst to the other player.
(make-string indent #\space) (play->string play)) (if ((caar plays) . < . +inf.0)
(if (= -inf.0 (car play)) (sort
(begin (map
(log-printf 4 indent " ~a>>>> losing\n" (lambda (play)
(make-string indent #\space)) (log-printf 4 indent " ~a>>> Checking: ~a\n"
play) (make-string indent #\space) (play->string play))
(let ([r (cons (- (car (multi-step-minmax (cond
(sub1 steps) span config [(= -inf.0 (car play))
(+ 3 indent) init-memory (log-printf 4 indent " ~a>>>> losing\n"
(other me) (make-string indent #\space))
(apply-play board (cdr play))))) play]
(cdr play))]) [(eq? 'loop! (cdr play))
(log-printf 4 indent " ~a>>>> deeper = ~a\n" (log-printf 4 indent " ~a>>>> tying\n"
(make-string indent #\space) (make-string indent #\space))
(float->string (car r))) play]
r))) [else
plays) (let ([r (cons (- (car (multi-step-minmax
(lambda (a b) (> (car a) (car b)))) (sub1 steps) span config
(list (car plays)))]) (+ 3 indent) init-memory
(first nexts)))))) (other me)
(apply-play board (cdr play)))))
(cdr play))])
(log-printf 4 indent " ~a>>>> deeper = ~a\n"
(make-string indent #\space)
(float->string (car r)))
r)]))
plays)
(lambda (a b) (> (car a) (car b))))
(list (car plays)))])
(first nexts))]))))
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
;; Multi-run memory: ;; Multi-run memory:

8
pkgs/games/gobblet/robot.rkt
View File

@ -41,7 +41,10 @@
(unless (zero? how-many) (unless (zero? how-many)
(set! how-many (sub1 how-many)) (set! how-many (sub1 how-many))
;(sleep 1) ;(sleep 1)
;; (random-seed 12) (define s (bitwise-and (+ (current-milliseconds) (random 100))
(sub1 (expt 2 31))))
(printf "Random seed: ~s\n" s)
(random-seed s)
(let loop ([board init-board] (let loop ([board init-board]
[who init-who] [who init-who]
[who-moved "no one"] [who-moved "no one"]
@ -53,6 +56,9 @@
[(winner? board (other who)) [(winner? board (other who))
(printf "----------- ~a wins!-------------\n~a\n" (other who) (board->string 1 board)) (printf "----------- ~a wins!-------------\n~a\n" (other who) (board->string 1 board))
(go)] (go)]
[(member board history)
(printf "----------- tie! -------------\n~a\n" (board->string 1 board))
(go)]
[else [else
(printf "\n~a moved; ~a's turn\n~a\n" who-moved who (board->string 1 board)) (printf "\n~a moved; ~a's turn\n~a\n" who-moved who (board->string 1 board))
(let ([start (current-inexact-milliseconds)] (let ([start (current-inexact-milliseconds)]