DrDr props and stderr removal
svn: r15477
This commit is contained in:
parent
4e40450248
commit
a6312e8050
|
@ -3,74 +3,78 @@
|
||||||
|
|
||||||
(module robot mzscheme
|
(module robot mzscheme
|
||||||
(require mzlib/unitsig
|
(require mzlib/unitsig
|
||||||
mzlib/etc
|
mzlib/etc
|
||||||
mzlib/list
|
mzlib/list
|
||||||
"sig.ss"
|
"sig.ss"
|
||||||
"model.ss"
|
"model.ss"
|
||||||
"explore.ss"
|
"explore.ss"
|
||||||
"heuristics.ss")
|
"heuristics.ss")
|
||||||
|
|
||||||
(define board-size 3)
|
(define board-size 3)
|
||||||
(define steps 2)
|
(define steps 2)
|
||||||
(define depth 3)
|
(define depth 3)
|
||||||
|
|
||||||
(define timeout 3.0)
|
(define timeout 3.0)
|
||||||
(define cannon-size +inf.0)
|
(define cannon-size +inf.0)
|
||||||
|
|
||||||
(invoke-unit/sig
|
(invoke-unit/sig
|
||||||
(compound-unit/sig
|
(compound-unit/sig
|
||||||
(import)
|
(import)
|
||||||
(link
|
(link
|
||||||
[CONFIG : config^ ((unit/sig config^
|
[CONFIG : config^ ((unit/sig config^
|
||||||
(import)
|
(import)
|
||||||
(define BOARD-SIZE board-size)))]
|
(define BOARD-SIZE board-size)))]
|
||||||
[MODEL : model^ (model-unit CONFIG)]
|
[MODEL : model^ (model-unit CONFIG)]
|
||||||
[HEURISTICS : heuristics^ (heuristics-unit CONFIG MODEL EXPLORE)]
|
[HEURISTICS : heuristics^ (heuristics-unit CONFIG MODEL EXPLORE)]
|
||||||
[EXPLORE : explore^ (explore-unit CONFIG MODEL)]
|
[EXPLORE : explore^ (explore-unit CONFIG MODEL)]
|
||||||
[ROBOT : () ((unit/sig ()
|
[ROBOT : () ((unit/sig ()
|
||||||
(import config^ explore^ model^ heuristics^)
|
(import config^ explore^ model^ heuristics^)
|
||||||
|
|
||||||
(define init-board
|
(define init-board
|
||||||
empty-board
|
empty-board
|
||||||
#;
|
#;
|
||||||
(move empty-board
|
(move empty-board
|
||||||
(list-ref red-pieces 2) #f #f 0 0
|
(list-ref red-pieces 2) #f #f 0 0
|
||||||
(lambda (b)
|
(lambda (b)
|
||||||
(move b
|
(move b
|
||||||
(list-ref yellow-pieces 2) #f #f 0 1
|
(list-ref yellow-pieces 2) #f #f 0 1
|
||||||
(lambda (b) b)
|
(lambda (b) b)
|
||||||
void))
|
void))
|
||||||
void))
|
void))
|
||||||
(define init-who 'red)
|
(define init-who 'red)
|
||||||
|
; Only play 50 games to control run time
|
||||||
;; Play-a-game test
|
(define how-many 50)
|
||||||
(let go ()
|
|
||||||
(sleep 1)
|
;; Play-a-game test
|
||||||
;; (random-seed 12)
|
(let go ()
|
||||||
(let loop ([board init-board]
|
(unless (zero? how-many)
|
||||||
[who init-who]
|
(set! how-many (sub1 how-many))
|
||||||
[who-moved "no one"]
|
;(sleep 1)
|
||||||
[history null])
|
;; (random-seed 12)
|
||||||
(cond
|
(let loop ([board init-board]
|
||||||
[(winner? board who)
|
[who init-who]
|
||||||
(printf "----------- ~a wins!-------------~n~a~n" who (board->string 1 board))
|
[who-moved "no one"]
|
||||||
(go)]
|
[history null])
|
||||||
[(winner? board (other who))
|
(cond
|
||||||
(printf "----------- ~a wins!-------------~n~a~n" (other who) (board->string 1 board))
|
[(winner? board who)
|
||||||
(go)]
|
(printf "----------- ~a wins!-------------~n~a~n" who (board->string 1 board))
|
||||||
[else
|
(go)]
|
||||||
(printf "~n~a moved; ~a's turn~n~a~n" who-moved who (board->string 1 board))
|
[(winner? board (other who))
|
||||||
(let ([start (current-inexact-milliseconds)]
|
(printf "----------- ~a wins!-------------~n~a~n" (other who) (board->string 1 board))
|
||||||
[m ((make-search (if (= BOARD-SIZE 3)
|
(go)]
|
||||||
make-3x3-rate-board
|
[else
|
||||||
make-4x4-rate-board)
|
(printf "~n~a moved; ~a's turn~n~a~n" who-moved who (board->string 1 board))
|
||||||
(if (= BOARD-SIZE 3)
|
(let ([start (current-inexact-milliseconds)]
|
||||||
make-3x3-no-canned-moves
|
[m ((make-search (if (= BOARD-SIZE 3)
|
||||||
make-4x4-canned-moves))
|
make-3x3-rate-board
|
||||||
timeout steps depth
|
make-4x4-rate-board)
|
||||||
who board history)])
|
(if (= BOARD-SIZE 3)
|
||||||
(printf "[~a secs]~n" (/ (- (current-inexact-milliseconds) start)
|
make-3x3-no-canned-moves
|
||||||
1000.0))
|
make-4x4-canned-moves))
|
||||||
(loop (apply-play board m) (other who) who (cons board history)))]))))
|
timeout steps depth
|
||||||
CONFIG EXPLORE MODEL HEURISTICS)])
|
who board history)])
|
||||||
(export))))
|
(printf "[~a secs]~n" (/ (- (current-inexact-milliseconds) start)
|
||||||
|
1000.0))
|
||||||
|
(loop (apply-play board m) (other who) who (cons board history)))])))))
|
||||||
|
CONFIG EXPLORE MODEL HEURISTICS)])
|
||||||
|
(export))))
|
||||||
|
|
|
@ -40,7 +40,7 @@
|
||||||
|
|
||||||
(define-values (print-bootstrapping)
|
(define-values (print-bootstrapping)
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(fprintf (current-error-port) "setup-plt: bootstrapping from source...\n")))
|
(fprintf (current-output-port) "setup-plt: bootstrapping from source...\n")))
|
||||||
|
|
||||||
(if (or (on? 'clean values)
|
(if (or (on? 'clean values)
|
||||||
(on? 'make-zo not))
|
(on? 'make-zo not))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user