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

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

@ -41,7 +41,10 @@
(unless (zero? how-many)
(set! how-many (sub1 how-many))
;(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]
[who init-who]
[who-moved "no one"]
@ -53,6 +56,9 @@
[(winner? board (other who))
(printf "----------- ~a wins!-------------\n~a\n" (other who) (board->string 1 board))
(go)]
[(member board history)
(printf "----------- tie! -------------\n~a\n" (board->string 1 board))
(go)]
[else
(printf "\n~a moved; ~a's turn\n~a\n" who-moved who (board->string 1 board))
(let ([start (current-inexact-milliseconds)]