DrDr props and stderr removal

svn: r15477
This commit is contained in:
Jay McCarthy 2009-07-17 17:59:36 +00:00
parent 4e40450248
commit a6312e8050
2 changed files with 69 additions and 65 deletions

View File

@ -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))))

View File

@ -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))