From a6312e8050459b941cdf8234e39a2ffa4723fc5c Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Fri, 17 Jul 2009 17:59:36 +0000 Subject: [PATCH] DrDr props and stderr removal svn: r15477 --- collects/games/gobblet/robot.ss | 132 ++++++++++++++++---------------- collects/setup/main.ss | 2 +- 2 files changed, 69 insertions(+), 65 deletions(-) diff --git a/collects/games/gobblet/robot.ss b/collects/games/gobblet/robot.ss index d8f87f8230..2297313051 100644 --- a/collects/games/gobblet/robot.ss +++ b/collects/games/gobblet/robot.ss @@ -3,74 +3,78 @@ (module robot mzscheme (require mzlib/unitsig - mzlib/etc - mzlib/list - "sig.ss" - "model.ss" - "explore.ss" - "heuristics.ss") - + mzlib/etc + mzlib/list + "sig.ss" + "model.ss" + "explore.ss" + "heuristics.ss") + (define board-size 3) (define steps 2) (define depth 3) - + (define timeout 3.0) (define cannon-size +inf.0) - + (invoke-unit/sig (compound-unit/sig - (import) - (link - [CONFIG : config^ ((unit/sig config^ - (import) - (define BOARD-SIZE board-size)))] - [MODEL : model^ (model-unit CONFIG)] - [HEURISTICS : heuristics^ (heuristics-unit CONFIG MODEL EXPLORE)] - [EXPLORE : explore^ (explore-unit CONFIG MODEL)] - [ROBOT : () ((unit/sig () - (import config^ explore^ model^ heuristics^) - - (define init-board - empty-board - #; - (move empty-board - (list-ref red-pieces 2) #f #f 0 0 - (lambda (b) - (move b - (list-ref yellow-pieces 2) #f #f 0 1 - (lambda (b) b) - void)) - void)) - (define init-who 'red) - - ;; Play-a-game test - (let go () - (sleep 1) - ;; (random-seed 12) - (let loop ([board init-board] - [who init-who] - [who-moved "no one"] - [history null]) - (cond - [(winner? board who) - (printf "----------- ~a wins!-------------~n~a~n" who (board->string 1 board)) - (go)] - [(winner? board (other who)) - (printf "----------- ~a wins!-------------~n~a~n" (other who) (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)] - [m ((make-search (if (= BOARD-SIZE 3) - make-3x3-rate-board - make-4x4-rate-board) - (if (= BOARD-SIZE 3) - make-3x3-no-canned-moves - make-4x4-canned-moves)) - timeout steps depth - who board history)]) - (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)))) + (import) + (link + [CONFIG : config^ ((unit/sig config^ + (import) + (define BOARD-SIZE board-size)))] + [MODEL : model^ (model-unit CONFIG)] + [HEURISTICS : heuristics^ (heuristics-unit CONFIG MODEL EXPLORE)] + [EXPLORE : explore^ (explore-unit CONFIG MODEL)] + [ROBOT : () ((unit/sig () + (import config^ explore^ model^ heuristics^) + + (define init-board + empty-board + #; + (move empty-board + (list-ref red-pieces 2) #f #f 0 0 + (lambda (b) + (move b + (list-ref yellow-pieces 2) #f #f 0 1 + (lambda (b) b) + void)) + void)) + (define init-who 'red) + ; Only play 50 games to control run time + (define how-many 50) + + ;; Play-a-game test + (let go () + (unless (zero? how-many) + (set! how-many (sub1 how-many)) + ;(sleep 1) + ;; (random-seed 12) + (let loop ([board init-board] + [who init-who] + [who-moved "no one"] + [history null]) + (cond + [(winner? board who) + (printf "----------- ~a wins!-------------~n~a~n" who (board->string 1 board)) + (go)] + [(winner? board (other who)) + (printf "----------- ~a wins!-------------~n~a~n" (other who) (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)] + [m ((make-search (if (= BOARD-SIZE 3) + make-3x3-rate-board + make-4x4-rate-board) + (if (= BOARD-SIZE 3) + make-3x3-no-canned-moves + make-4x4-canned-moves)) + timeout steps depth + who board history)]) + (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)))) diff --git a/collects/setup/main.ss b/collects/setup/main.ss index 6847f538da..ddfde737ba 100644 --- a/collects/setup/main.ss +++ b/collects/setup/main.ss @@ -40,7 +40,7 @@ (define-values (print-bootstrapping) (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) (on? 'make-zo not))