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

put the requires in the right place

Browse Source 
svn: r13690
This commit is contained in:
Robby Findler 2009-02-17 13:48:39 +00:00
parent c82cc16dfc
commit 80bcae687c
1 changed files with 114 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

197
collects/games/chat-noir/chat-noir-literate.ss
View File

@ -1,8 +1,5 @@
#reader "literate-reader.ss" #reader "literate-reader.ss"
@(require scheme/local scheme/list scheme/bool scheme/math
(for-syntax scheme/base))
@title{Chat Noir} @title{Chat Noir}
The goal of Chat Noir is to stop the cat from escaping the board. Each The goal of Chat Noir is to stop the cat from escaping the board. Each
@ -37,7 +34,9 @@ code that handles drawing of the world, code that handles user input,
and some code that builds an initial world and starts the game. and some code that builds an initial world and starts the game.
@chunk[<main> @chunk[<main>
(require htdp/world lang/posn) (require scheme/local scheme/list scheme/bool scheme/math
(for-syntax scheme/base))
(require htdp/world lang/posn scheme/contract)
<world> <world>
<graph> <graph>
<tests> <tests>
@ -172,8 +171,8 @@ flattens the nested lists and the
@scheme[filter] expression removes the corners. @scheme[filter] expression removes the corners.
@chunk[<empty-board> @chunk[<empty-board>
;; empty-board : number -> (listof cell) (define/contract (empty-board board-size)
(define (empty-board board-size) (-> natural-number/c (listof cell?))
(filter (filter
(not-corner? board-size) (not-corner? board-size)
(apply (apply
@ -187,7 +186,8 @@ flattens the nested lists and the
(make-cell (make-posn i j) (make-cell (make-posn i j)
false)))))))) false))))))))
(define ((not-corner? board-size) c) (define/contract ((not-corner? board-size) c)
(-> natural-number/c (-> cell? boolean?))
(not (and (= 0 (posn-x (cell-p c))) (not (and (= 0 (posn-x (cell-p c)))
(or (= 0 (posn-y (cell-p c))) (or (= 0 (posn-y (cell-p c)))
(= (- board-size 1) (= (- board-size 1)
@ -249,6 +249,7 @@ X parts ....
<dist-cell-data-definition> <dist-cell-data-definition>
<build-bfs-table> <build-bfs-table>
<neighbors> <neighbors>
<neighbors-blocked/boundary>
<lookup-in-table> <lookup-in-table>
<on-cats-path?> <on-cats-path?>
@ -374,6 +375,10 @@ It accepts a world and returns a function
that computes the neighbors of the boundary that computes the neighbors of the boundary
and of nodes. and of nodes.
The neighbors functions accepts a @scheme[world] and then
returns a function that computes the neighbors of a @scheme[posn]
and of the @scheme['boundary].
For example, @scheme[(make-posn 1 0)] has four For example, @scheme[(make-posn 1 0)] has four
neighbors: neighbors:
@ -394,16 +399,23 @@ and @scheme[(make-posn 0 1)] has four neighbors:
(make-posn 0 2) (make-posn 0 2)
(make-posn 1 2)))] (make-posn 1 2)))]
as you can see from the pictures of the empty boards above. as you can see from the pictures of the 7x7 empty board above.
Also, there are 6 neighbors of the boundary in the 3x3 board:
This is the neighbors function. It first accepts a @scheme[world] @chunk[<neighbors-tests>
and then builds a list of the blocked cells in the world and a (test ((neighbors (empty-world 3)) 'boundary)
list of the cells that are on the boundary (and not blocked). (list (make-posn 0 1)
(make-posn 1 0)
(make-posn 1 2)
(make-posn 2 0)
(make-posn 2 1)
(make-posn 2 2)))]
The result is a function that accepts a @scheme[posn] or @scheme['boundary].
If @scheme[p] is blocked, the function returns the empty list. If it is This is the neighbors function. After it accepts the @scheme[world],
on the boundary, the function simply returns @scheme[boundary-cells]. it builds a list of the blocked cells in the world and a
Finally, list of the cells that are on the boundary (and not blocked). Then it
returns a function that is specialized to those values.
@chunk[<neighbors> @chunk[<neighbors>
;; neighbors : world -> (or/c 'boundary posn) -> (listof (or/c 'boundary posn)) ;; neighbors : world -> (or/c 'boundary posn) -> (listof (or/c 'boundary posn))
@ -420,68 +432,45 @@ Finally,
(on-boundary? p (world-size w)))) (on-boundary? p (world-size w))))
(map cell-p (world-board w)))) (map cell-p (world-board w))))
(λ (p) (λ (p)
(cond (neighbors-blocked/boundary blocked
[(member p blocked) boundary-cells
'()] (world-size w)
[(equal? p 'boundary) p)))]
boundary-cells]
[else The @scheme[neighbors-blocked/boundary] function is given next.
(let* ([x (posn-x p)] If @scheme[p] is blocked, it returns the empty list. If it is
[adjacent-posns on the boundary, the function simply returns @scheme[boundary-cells].
(filter (λ (x) (not (member x blocked))) Otherwise, @scheme[neighbors-blocked/boundary] calls
(adjacent p (world-size w)))] @scheme[adjacent] to compute the posns that are adjacent to @scheme[p],
[in-bounds filtering out the blocked @scheme[posn]s and binds that to @scheme[adjacent-posns].
(filter (λ (x) (in-bounds? x (world-size w))) It then filters out the @scheme[posn]s that would be outside of the board.
adjacent-posns)]) If those two lists are the same, then @scheme[p] is not on the boundary,
(cond so we just return @scheme[in-bounds]. If the lists are different, then
[(equal? in-bounds adjacent-posns) we know that @scheme[p] must have been on the boundary, so we add
in-bounds] @scheme['boundary] to the result list.
[else
(cons 'boundary in-bounds)]))])))] @chunk[<neighbors-blocked/boundary>
;; neighbors : world -> (or/c 'boundary posn) -> (listof (or/c 'boundary posn))
(define (neighbors-blocked/boundary blocked boundary-cells size p)
(cond
[(member p blocked)
'()]
[(equal? p 'boundary)
boundary-cells]
[else
(let* ([x (posn-x p)]
[adjacent-posns
(filter (λ (x) (not (member x blocked)))
(adjacent p))]
[in-bounds
(filter (λ (x) (in-bounds? x size))
adjacent-posns)])
(cond
[(equal? in-bounds adjacent-posns)
in-bounds]
[else
(cons 'boundary in-bounds)]))]))]
@chunk[<neighbors-tests>
(test ((neighbors (empty-world 11)) (make-posn 1 1))
(adjacent (make-posn 1 1) 11))
(test ((neighbors (empty-world 11)) (make-posn 2 2))
(adjacent (make-posn 2 2) 11))
(test ((neighbors (empty-world 3)) 'boundary)
(list (make-posn 0 1)
(make-posn 1 0)
(make-posn 1 2)
(make-posn 2 0)
(make-posn 2 1)
(make-posn 2 2)))
(test ((neighbors (make-world (list
(make-cell (make-posn 0 1) false)
(make-cell (make-posn 1 0) false)
(make-cell (make-posn 1 1) true)
(make-cell (make-posn 1 2) false)
(make-cell (make-posn 2 0) false)
(make-cell (make-posn 2 1) false)
(make-cell (make-posn 2 2) false))
(make-posn 1 1)
'playing
3
(make-posn 0 0)
false))
(make-posn 1 1))
'())
(test ((neighbors (make-world (list
(make-cell (make-posn 0 1) false)
(make-cell (make-posn 1 0) false)
(make-cell (make-posn 1 1) true)
(make-cell (make-posn 1 2) false)
(make-cell (make-posn 2 0) false)
(make-cell (make-posn 2 1) false)
(make-cell (make-posn 2 2) false))
(make-posn 1 1)
'playing
3
(make-posn 0 0)
false))
(make-posn 1 0))
(list 'boundary (make-posn 2 0) (make-posn 0 1)))
]
@chunk[<lookup-in-table> @chunk[<lookup-in-table>
;; lookup-in-table : distance-map posn -> number or '∞ ;; lookup-in-table : distance-map posn -> number or '∞
@ -517,8 +506,8 @@ Finally,
(let () (let ()
(define edge-distance-map (build-bfs-table w 'boundary)) (define edge-distance-map (build-bfs-table w 'boundary))
(define cat-distance-map (build-bfs-table w (world-cat w))) (define cat-distance-map (build-bfs-table w (world-cat w)))
(define cat-distance (lookup-in-table edge-distance-map (define cat-distance
(world-cat w))) (lookup-in-table edge-distance-map (world-cat w)))
(cond (cond
[(equal? cat-distance '∞) [(equal? cat-distance '∞)
(lambda (p) false)] (lambda (p) false)]
@ -563,10 +552,10 @@ Finally,
@chunk[<adjacent> @chunk[<adjacent>
;; adjacent : posn number -> (listof posn) ;; adjacent : posn -> (listof posn)
;; returns a list of the posns that are adjacent to ;; returns a list of the posns that are adjacent to
;; `p' on an infinite hex grid ;; `p' on an infinite hex grid
(define (adjacent p board-size) (define (adjacent p)
(local [(define x (posn-x p)) (local [(define x (posn-x p))
(define y (posn-y p))] (define y (posn-y p))]
(cond (cond
@ -586,14 +575,14 @@ Finally,
(make-posn (+ x 1) (+ y 1)))])))] (make-posn (+ x 1) (+ y 1)))])))]
@chunk[<adjacent-tests> @chunk[<adjacent-tests>
(test (adjacent (make-posn 1 1) 11) (test (adjacent (make-posn 1 1))
(list (make-posn 1 0) (list (make-posn 1 0)
(make-posn 2 0) (make-posn 2 0)
(make-posn 0 1) (make-posn 0 1)
(make-posn 2 1) (make-posn 2 1)
(make-posn 1 2) (make-posn 1 2)
(make-posn 2 2))) (make-posn 2 2)))
(test (adjacent (make-posn 2 2) 11) (test (adjacent (make-posn 2 2))
(list (make-posn 1 1) (list (make-posn 1 1)
(make-posn 2 1) (make-posn 2 1)
(make-posn 1 2) (make-posn 1 2)
@ -887,6 +876,48 @@ Finally,
(make-posn 1 4)) (make-posn 1 4))
2)] 2)]
@chunk[<neighbors-tests>
(test ((neighbors (empty-world 11)) (make-posn 1 1))
(adjacent (make-posn 1 1)))
(test ((neighbors (empty-world 11)) (make-posn 2 2))
(adjacent (make-posn 2 2)))
(test ((neighbors (empty-world 3)) 'boundary)
(list (make-posn 0 1)
(make-posn 1 0)
(make-posn 1 2)
(make-posn 2 0)
(make-posn 2 1)
(make-posn 2 2)))
(test ((neighbors (make-world (list
(make-cell (make-posn 0 1) false)
(make-cell (make-posn 1 0) false)
(make-cell (make-posn 1 1) true)
(make-cell (make-posn 1 2) false)
(make-cell (make-posn 2 0) false)
(make-cell (make-posn 2 1) false)
(make-cell (make-posn 2 2) false))
(make-posn 1 1)
'playing
3
(make-posn 0 0)
false))
(make-posn 1 1))
'())
(test ((neighbors (make-world (list
(make-cell (make-posn 0 1) false)
(make-cell (make-posn 1 0) false)
(make-cell (make-posn 1 1) true)
(make-cell (make-posn 1 2) false)
(make-cell (make-posn 2 0) false)
(make-cell (make-posn 2 1) false)
(make-cell (make-posn 2 2) false))
(make-posn 1 1)
'playing
3
(make-posn 0 0)
false))
(make-posn 1 0))
(list 'boundary (make-posn 2 0) (make-posn 0 1)))]
@section{Everything Else} @section{Everything Else}
@ -1537,7 +1568,7 @@ Finally,
(define (move-cat world) (define (move-cat world)
(local [(define cat-position (world-cat world)) (local [(define cat-position (world-cat world))
(define table (build-bfs-table world 'boundary)) (define table (build-bfs-table world 'boundary))
(define neighbors (adjacent cat-position (world-size world))) (define neighbors (adjacent cat-position))
(define next-cat-positions (define next-cat-positions
(find-best-positions neighbors (find-best-positions neighbors
(map (lambda (p) (lookup-in-table table p)) (map (lambda (p) (lookup-in-table table p))