improved the cat algorithm (fixed it really) and prepared things for more feedback about where the cat would like to go

svn: r12902

collects/games/chat-noir/chat-noir-module.ss

@@ -1,5 +1,5 @@
 (module chat-noir-module lang/htdp-intermediate-lambda
   (require (lib "world.ss" "htdp"))
-  (require "hash.ss")
+;  (require "hash.ss")
   (require (lib "include.ss" "scheme"))
   (include "chat-noir.ss"))

collects/games/chat-noir/chat-noir.ss

@@ -1,7 +1,14 @@
+(require "hash.ss")
+
 ;; constants
 (define circle-radius 20)
 (define circle-spacing 22)
 
+(define normal-color 'lightskyblue)
+(define on-shortest-path-color normal-color)
+;(define on-shortest-path-color 'cornflowerblue)
+(define blocked-color 'black)
+
 ;; data definitions
 
 ;; a world is:
@@ -47,7 +54,9 @@
 ;; world->image : world -> image
 (define (world->image w)
   (chop-whiskers
-   (overlay (board->image (world-board w) (world-size w))
+   (overlay (board->image (world-board w) 
+                          (world-size w)
+                          (on-cats-path? w))
             (move-pinhole
              (cond
                [(equal? (world-state w) 'cat-won) happy-cat]
@@ -55,7 +64,7 @@
                [else thinking-cat])
              (- (cell-center-x (world-cat w)))
              (- (cell-center-y (world-cat w)))))))
-
+  
 (check-expect
  (world->image
   (make-world (list (make-cell (make-posn 0 1) false))
@@ -64,10 +73,12 @@
               2))
  (overlay
   (board->image (list (make-cell (make-posn 0 1) false))
-                2)
+                2
+                (lambda (x) true))
   (move-pinhole thinking-cat 
                 (- (cell-center-x (make-posn 0 1)))
                 (- (cell-center-y (make-posn 0 1))))))
+
 (check-expect
  (world->image
   (make-world (list (make-cell (make-posn 0 1) false))
@@ -76,10 +87,12 @@
               2))
  (overlay
   (board->image (list (make-cell (make-posn 0 1) false))
-                2)
+                2
+                (lambda (x) true))
   (move-pinhole happy-cat 
                 (- (cell-center-x (make-posn 0 1)))
                 (- (cell-center-y (make-posn 0 1))))))
+
 (check-expect
  (world->image
   (make-world (list (make-cell (make-posn 0 1) false))
@@ -88,7 +101,8 @@
               2))
  (overlay
   (board->image (list (make-cell (make-posn 0 1) false))
-                2)
+                2
+                (lambda (x) true))
   (move-pinhole sad-cat 
                 (- (cell-center-x (make-posn 0 1)))
                 (- (cell-center-y (make-posn 0 1))))))
@@ -111,65 +125,108 @@
  (pinhole-x
   (world->image 
    (make-world
-    (list (make-cell (make-posn 0 0) false)
+    (empty-board 3)
-          (make-cell (make-posn 0 1) false)
-          (make-cell (make-posn 1 0) false))
     (make-posn 0 0)
     'playing
-    2)))
+    3)))
  0)
 (check-expect
  (pinhole-x
   (world->image
    (make-world
-    (list (make-cell (make-posn 0 0) false)
+    (empty-board 3)
-          (make-cell (make-posn 0 1) false)
-          (make-cell (make-posn 1 0) false))
     (make-posn 0 1)
     'playing
-    2)))
+    3)))
  0)
 
 
-;; board->image : board number -> image
+;; board->image : board number (posn -> boolean) -> image
-(define (board->image cs world-size)
+(define (board->image cs world-size on-cat-path?)
   (foldl (lambda (x y) (overlay y x))
          (nw:rectangle (world-width world-size)
                        (world-height world-size)
                        'solid
                        'white)
-         (map cell->image cs)))
+         (map (lambda (c) (cell->image c (on-cat-path? (cell-p c))))
+              cs)))
 
-(check-expect (board->image (list (make-cell (make-posn 0 0) false)) 3)
+(check-expect (board->image (list (make-cell (make-posn 0 0) false))
+                            3
+                            (lambda (x) false))
               (overlay
                (nw:rectangle (world-width 3)
                              (world-height 3)
                              'solid
                              'white)
-               (cell->image (make-cell (make-posn 0 0) false))))
+               (cell->image (make-cell (make-posn 0 0) false)
+                            false)))
+
+(check-expect (board->image (list (make-cell (make-posn 0 0) false))
+                            3
+                            (lambda (x) true))
+              (overlay
+               (nw:rectangle (world-width 3)
+                             (world-height 3)
+                             'solid
+                             'white)
+               (cell->image (make-cell (make-posn 0 0) false)
+                            true)))
 
 
-;; cell->image : cell -> image
+(check-expect (board->image (list (make-cell (make-posn 0 0) false))
-(define (cell->image c)
+                            3
+                            (lambda (x) false))
+              (overlay
+               (nw:rectangle (world-width 3)
+                             (world-height 3)
+                             'solid
+                             'white)
+               (cell->image (make-cell (make-posn 0 0) false)
+                            false)))
+
+(check-expect (board->image (list (make-cell (make-posn 0 0) false)
+                                  (make-cell (make-posn 0 1) false))
+                            3
+                            (lambda (x) (equal? x (make-posn 0 1))))
+              (overlay
+               (nw:rectangle (world-width 3)
+                             (world-height 3)
+                             'solid
+                             'white)
+               (cell->image (make-cell (make-posn 0 0) false)
+                            false)
+               (cell->image (make-cell (make-posn 0 1) false)
+                            true)))
+
+
+;; cell->image : cell boolean -> image
+(define (cell->image c on-short-path?)
   (local [(define x (cell-center-x (cell-p c)))
           (define y (cell-center-y (cell-p c)))]
     (move-pinhole 
      (cond
+       [on-short-path?
+        (circle circle-radius 'solid on-shortest-path-color)]
        [(cell-blocked? c)
-        (circle circle-radius 'solid 'black)]
+        (circle circle-radius 'solid blocked-color)]
        [else
-        (circle circle-radius 'solid 'lightblue)])
+        (circle circle-radius 'solid normal-color)])
      (- x)
      (- y))))
 
-(check-expect (cell->image (make-cell (make-posn 0 0) false))
+(check-expect (cell->image (make-cell (make-posn 0 0) false) false)
-              (move-pinhole (circle circle-radius 'solid 'lightblue)
+              (move-pinhole (circle circle-radius 'solid normal-color)
                             (- circle-radius)
                             (- circle-radius)))
-(check-expect (cell->image (make-cell (make-posn 0 0) true))
+(check-expect (cell->image (make-cell (make-posn 0 0) true) false)
               (move-pinhole (circle circle-radius 'solid 'black)
                             (- circle-radius)
                             (- circle-radius)))
+(check-expect (cell->image (make-cell (make-posn 0 0) false) true)
+              (move-pinhole (circle circle-radius 'solid on-shortest-path-color)
+                            (- circle-radius)
+                            (- circle-radius)))
 
 ;; world-width : number -> number
 ;; computes the width of the drawn world in terms of its size
@@ -249,231 +306,227 @@
 ;;  - (make-dist-cell posn (number or '∞))
 (define-struct dist-cell (p n))
 
-;; build-table/fast : world -> distance-map
+
-(define (build-table/fast world)
+;; build-bfs-table : world (or/c 'boundary posn) -> distance-table
-  (local [(define board-size (world-size world))
+(define (build-bfs-table world init-point)
-          (define blocked (make-hash))
+  (local [;; posn : posn
-          (define ht (make-hash))
+          ;; dist : number
-          (define (search p)
+          (define-struct queue-ent (posn dist))
+          
+          (define neighbors/w (neighbors world))
+          
+          (define (bfs queue dist-table)
             (cond
-              [(hash-ref blocked p)
+              [(empty? queue) dist-table]
-               '∞]
-              [(on-boundary? p board-size) 
-               ((lambda (a b) b)
-                (hash-set! ht p 0)
-                0)]
-              [(not (boolean? (hash-ref ht p #f)))
-               (hash-ref ht p)]
               [else
-               ((lambda (a b c) c)
+               (local [(define hd (first queue))]
-                (hash-set! ht p '∞)
+                 (cond
-                (hash-set! 
+                   [(boolean? (hash-ref dist-table (queue-ent-posn hd) #f))
-                 ht
+                    (local [(define dist (queue-ent-dist hd))
-                 p
+                            (define p (queue-ent-posn hd))]
-                 (add1/f (min-l (map search 
+                      (bfs 
-                                     (adjacent p board-size)))))
+                       (append (rest queue) 
-                (hash-ref ht p))]))]
+                               (map (lambda (p) (make-queue-ent p (+ dist 1)))
-    ((lambda (a b c) c)
+                                    (neighbors/w p)))
-     (for-each (lambda (cell)
+                       (hash-set dist-table p dist)))]
-                 (hash-set! blocked 
+                   [else
-                            (cell-p cell)
+                    (bfs (rest queue) dist-table)]))]))]
-                            (cell-blocked? cell)))
+                    
-               (world-board world))
+    (hash-map 
-     (search (world-cat world))
+     (bfs (list (make-queue-ent init-point 0))
-     (hash-map ht make-dist-cell))))
+          (make-immutable-hash/list-init))
+     make-dist-cell)))
 
-;; build-table : world -> distance-map
+;; same-sets? : (listof X) (listof X) -> boolean
-(define (build-table world)
+(define (same-sets? l1 l2)
-  (build-distance (world-board world)
+  (and (andmap (lambda (e1) (member e1 l2)) l1)
-                  (world-cat world)
+       (andmap (lambda (e2) (member e2 l1)) l2)))
-                  '()
-                  '()
-                  (world-size world)))
 
-;; build-distance : board posn distance-map (listof posn) number -> distance-map
+(check-expect (same-sets? (list) (list)) true)
-(define (build-distance board p t visited board-size)
+(check-expect (same-sets? (list) (list 1)) false)
-  (cond
+(check-expect (same-sets? (list 1) (list)) false)
-    [(cell-blocked? (lookup-board board p)) 
+(check-expect (same-sets? (list 1 2) (list 2 1)) true)
-     (add-to-table p '∞ t)]
-    [(on-boundary? p board-size)
-     (add-to-table p 0 t)]
-    [(in-table? t p)
-     t]
-    [(member p visited)
-     (add-to-table p '∞ t)]
-    [else
-     (local [(define neighbors (adjacent p board-size))
-             (define neighbors-t (build-distances
-                                  board
-                                  neighbors
-                                  t
-                                  (cons p visited)
-                                  board-size))]
-       (add-to-table p
-                     (add1/f 
-                      (min-l 
-                       (map (lambda (neighbor)
-                              (lookup-in-table neighbors-t neighbor))
-                            neighbors)))
-                     neighbors-t))]))
 
-;; build-distances : board (listof posn) distance-map (listof posn) number 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;                -> distance-map
-(define (build-distances board ps t visited board-size)
-  (cond
-    [(empty? ps) t]
-    [else 
-     (build-distances board 
-                      (rest ps) 
-                      (build-distance board (first ps) t visited board-size)
-                      visited
-                      board-size)]))
 
-(check-expect (build-distance (list (make-cell (make-posn 0 0) false)) 
+(check-expect (same-sets? 
-                              (make-posn 0 0)
+               (build-bfs-table (make-world (empty-board 3) (make-posn 1 1) 'playing 3)
-                              '()
+                                'boundary)
-                              '()
+               (list
-                              1)
+                (make-dist-cell 'boundary 0)
-              (list (make-dist-cell (make-posn 0 0) 0)))
+                
-
+                (make-dist-cell (make-posn 1 0) 1)
-(check-expect (build-distance (list (make-cell (make-posn 0 0) true)) 
+                (make-dist-cell (make-posn 2 0) 1)
-                              (make-posn 0 0)
+                
-                              '()
+                (make-dist-cell (make-posn 0 1) 1)
-                              '()
+                (make-dist-cell (make-posn 1 1) 2)
-                              1)
+                (make-dist-cell (make-posn 2 1) 1)
-              (list (make-dist-cell (make-posn 0 0) '∞)))
+                
-
+                (make-dist-cell (make-posn 1 2) 1)
-(check-expect (build-distance (list (make-cell (make-posn 0 1) false)
+                (make-dist-cell (make-posn 2 2) 1)))
-                                    (make-cell (make-posn 1 0) false)
-                                    (make-cell (make-posn 1 1) false) 
-                                    (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)
-                              '()
-                              '()
-                              3)
-              (list (make-dist-cell (make-posn 1 0) 0) 
-                    (make-dist-cell (make-posn 2 0) 0) 
-                    (make-dist-cell (make-posn 0 1) 0)
-                    (make-dist-cell (make-posn 2 1) 0) 
-                    (make-dist-cell (make-posn 1 2) 0)
-                    (make-dist-cell (make-posn 2 2) 0)
-                    (make-dist-cell (make-posn 1 1) 1)))
-
-(check-expect (build-distance (list (make-cell (make-posn 0 1) true)
-                                    (make-cell (make-posn 1 0) true)
-                                    (make-cell (make-posn 1 1) false) 
-                                    (make-cell (make-posn 1 2) true)
-                                    (make-cell (make-posn 2 0) true) 
-                                    (make-cell (make-posn 2 1) true) 
-                                    (make-cell (make-posn 2 2) true)) 
-                              (make-posn 1 1)
-                              '()
-                              '()
-                              3)
-              (list (make-dist-cell (make-posn 1 0) '∞)
-                    (make-dist-cell (make-posn 2 0) '∞)
-                    (make-dist-cell (make-posn 0 1) '∞)
-                    (make-dist-cell (make-posn 2 1) '∞)
-                    (make-dist-cell (make-posn 1 2) '∞)
-                    (make-dist-cell (make-posn 2 2) '∞)
-                    (make-dist-cell (make-posn 1 1) '∞)))
-
-(check-expect (build-distance
-               (append-all
-                (build-list
-                 5
-                 (lambda (i)
-                   (build-list
-                    5
-                    (lambda (j) 
-                      (make-cell (make-posn i j) false))))))
-               (make-posn 2 2)
-               '()
-               '()
-               5)
-              (list (make-dist-cell (make-posn 1 0) 0)
-                    (make-dist-cell (make-posn 2 0) 0)
-                    (make-dist-cell (make-posn 0 1) 0)
-                    (make-dist-cell (make-posn 3 0) 0)
-                    (make-dist-cell (make-posn 1 1) 1)
-                    (make-dist-cell (make-posn 4 0) 0)
-                    (make-dist-cell (make-posn 2 1) 1)
-                    (make-dist-cell (make-posn 4 1) 0)
-                    (make-dist-cell (make-posn 3 1) 1)
-                    (make-dist-cell (make-posn 2 2) 2)
-                    (make-dist-cell (make-posn 4 2) 0)
-                    (make-dist-cell (make-posn 3 2) 1)
-                    (make-dist-cell (make-posn 0 2) 0)
-                    (make-dist-cell (make-posn 0 3) 0)
-                    (make-dist-cell (make-posn 1 3) 1)
-                    (make-dist-cell (make-posn 1 2) 1)
-                    (make-dist-cell (make-posn 2 3) 1)
-                    (make-dist-cell (make-posn 1 4) 0)
-                    (make-dist-cell (make-posn 2 4) 0)
-                    (make-dist-cell (make-posn 4 3) 0)
-                    (make-dist-cell (make-posn 3 4) 0)
-                    (make-dist-cell (make-posn 4 4) 0)
-                    (make-dist-cell (make-posn 3 3) 1)))
-
-
-;; lookup-board : board posn -> cell-or-false
-(define (lookup-board board p)
-  (cond
-    [(empty? board) (error 'lookup-board "did not find posn")]
-    [else
-     (cond
-       [(equal? (cell-p (first board)) p)
-        (first board)]
-       [else
-        (lookup-board (rest board) p)])]))
-
-(check-expect (lookup-board (list (make-cell (make-posn 2 2) false))
-                            (make-posn 2 2))
-              (make-cell (make-posn 2 2) false))
-(check-error (lookup-board '() (make-posn 0 0))
-             "lookup-board: did not find posn")
-
-;; add-to-table : posn (number or '∞) distance-map -> distance-map
-(define (add-to-table p n t) 
-  (cond
-    [(empty? t) (list (make-dist-cell p n))]
-    [else 
-     (cond
-       [(equal? p (dist-cell-p (first t)))
-        (cons (make-dist-cell p (min/f (dist-cell-n (first t)) n))
-              (rest t))]
-       [else
-        (cons (first t) (add-to-table p n (rest t)))])]))
-
-(check-expect (add-to-table (make-posn 1 2) 3 '())
-              (list (make-dist-cell (make-posn 1 2) 3)))
-(check-expect (add-to-table (make-posn 1 2)
-                            3
-                            (list (make-dist-cell (make-posn 1 2) 4)))
-              (list (make-dist-cell (make-posn 1 2) 3)))
-(check-expect (add-to-table (make-posn 1 2)
-                            3 
-                            (list (make-dist-cell (make-posn 1 2) 2)))
-              (list (make-dist-cell (make-posn 1 2) 2)))
-(check-expect (add-to-table (make-posn 1 2)
-                            3
-                            (list (make-dist-cell (make-posn 2 2) 2)))
-              (list (make-dist-cell (make-posn 2 2) 2)
-                    (make-dist-cell (make-posn 1 2) 3)))
-
-;; in-table : distance-map posn -> boolean
-(define (in-table? t p) (number? (lookup-in-table t p)))
-
-(check-expect (in-table? empty (make-posn 1 2)) false)
-(check-expect (in-table? (list (make-dist-cell (make-posn 1 2) 3))
-                         (make-posn 1 2))
               true)
-(check-expect (in-table? (list (make-dist-cell (make-posn 2 1) 3))
+
-                         (make-posn 1 2))
+(check-expect (same-sets? 
-              false)
+               (build-bfs-table (make-world (empty-board 3) (make-posn 1 1) 'playing 3)
+                                (make-posn 1 1))
+               (list
+                (make-dist-cell 'boundary 2)
+
+                (make-dist-cell (make-posn 1 0) 1)
+                (make-dist-cell (make-posn 2 0) 1)
+                
+                (make-dist-cell (make-posn 0 1) 1)
+                (make-dist-cell (make-posn 1 1) 0)
+                (make-dist-cell (make-posn 2 1) 1)
+                
+                (make-dist-cell (make-posn 1 2) 1)
+                (make-dist-cell (make-posn 2 2) 1)))
+              true)
+
+(check-expect (same-sets? 
+               (build-bfs-table (make-world (list
+                                             (make-cell (make-posn 0 1) true)
+                                             (make-cell (make-posn 1 0) true)
+                                             (make-cell (make-posn 1 1) false)
+                                             (make-cell (make-posn 1 2) true)
+                                             (make-cell (make-posn 2 0) true)
+                                             (make-cell (make-posn 2 1) true)
+                                             (make-cell (make-posn 2 2) true))
+                                            (make-posn 1 1)
+                                            'playing
+                                            3)
+                                'boundary)
+               (list
+                (make-dist-cell 'boundary 0)))
+              true)
+
+(check-expect (same-sets? 
+               (build-bfs-table (make-world (empty-board 5)
+                                            (make-posn 2 2)
+                                            'playing
+                                            5)
+                                'boundary)
+               (list
+                (make-dist-cell 'boundary 0)
+
+                (make-dist-cell (make-posn 1 0) 1)
+                (make-dist-cell (make-posn 2 0) 1)
+                (make-dist-cell (make-posn 3 0) 1)
+                (make-dist-cell (make-posn 4 0) 1)
+                
+                (make-dist-cell (make-posn 0 1) 1)
+                (make-dist-cell (make-posn 1 1) 2)
+                (make-dist-cell (make-posn 2 1) 2)
+                (make-dist-cell (make-posn 3 1) 2)
+                (make-dist-cell (make-posn 4 1) 1)
+                
+                (make-dist-cell (make-posn 0 2) 1)
+                (make-dist-cell (make-posn 1 2) 2)
+                (make-dist-cell (make-posn 2 2) 3)
+                (make-dist-cell (make-posn 3 2) 2)
+                (make-dist-cell (make-posn 4 2) 1)
+
+                (make-dist-cell (make-posn 0 3) 1)
+                (make-dist-cell (make-posn 1 3) 2)
+                (make-dist-cell (make-posn 2 3) 2)
+                (make-dist-cell (make-posn 3 3) 2)
+                (make-dist-cell (make-posn 4 3) 1)
+
+                
+                (make-dist-cell (make-posn 1 4) 1)
+                (make-dist-cell (make-posn 2 4) 1)
+                (make-dist-cell (make-posn 3 4) 1)
+                (make-dist-cell (make-posn 4 4) 1)))
+              true)
+
+(check-expect (same-sets? 
+               (build-bfs-table (make-world (block-cell
+                                             (make-posn 4 2)
+                                             (empty-board 5))
+                                            (make-posn 2 2)
+                                            'playing
+                                            5)
+                                'boundary)
+               (list
+                (make-dist-cell 'boundary 0)
+
+                (make-dist-cell (make-posn 1 0) 1)
+                (make-dist-cell (make-posn 2 0) 1)
+                (make-dist-cell (make-posn 3 0) 1)
+                (make-dist-cell (make-posn 4 0) 1)
+                
+                (make-dist-cell (make-posn 0 1) 1)
+                (make-dist-cell (make-posn 1 1) 2)
+                (make-dist-cell (make-posn 2 1) 2)
+                (make-dist-cell (make-posn 3 1) 2)
+                (make-dist-cell (make-posn 4 1) 1)
+                
+                (make-dist-cell (make-posn 0 2) 1)
+                (make-dist-cell (make-posn 1 2) 2)
+                (make-dist-cell (make-posn 2 2) 3)
+                (make-dist-cell (make-posn 3 2) 3)
+
+                (make-dist-cell (make-posn 0 3) 1)
+                (make-dist-cell (make-posn 1 3) 2)
+                (make-dist-cell (make-posn 2 3) 2)
+                (make-dist-cell (make-posn 3 3) 2)
+                (make-dist-cell (make-posn 4 3) 1)
+
+                
+                (make-dist-cell (make-posn 1 4) 1)
+                (make-dist-cell (make-posn 2 4) 1)
+                (make-dist-cell (make-posn 3 4) 1)
+                (make-dist-cell (make-posn 4 4) 1)))
+              true)
+
+(check-expect (same-sets? 
+               (build-bfs-table (make-world (empty-board 5)
+                                            (make-posn 2 2)
+                                            'playing
+                                            5)
+                                (make-posn 2 2))
+               (list
+                (make-dist-cell 'boundary 3)
+                
+                (make-dist-cell (make-posn 1 0) 2)
+                (make-dist-cell (make-posn 2 0) 2)
+                (make-dist-cell (make-posn 3 0) 2)
+                (make-dist-cell (make-posn 4 0) 3)
+                
+                (make-dist-cell (make-posn 0 1) 2)
+                (make-dist-cell (make-posn 1 1) 1)
+                (make-dist-cell (make-posn 2 1) 1)
+                (make-dist-cell (make-posn 3 1) 2)
+                (make-dist-cell (make-posn 4 1) 3)
+                
+                (make-dist-cell (make-posn 0 2) 2)
+                (make-dist-cell (make-posn 1 2) 1)
+                (make-dist-cell (make-posn 2 2) 0)
+                (make-dist-cell (make-posn 3 2) 1)
+                (make-dist-cell (make-posn 4 2) 2)
+
+                (make-dist-cell (make-posn 0 3) 2)
+                (make-dist-cell (make-posn 1 3) 1)
+                (make-dist-cell (make-posn 2 3) 1)
+                (make-dist-cell (make-posn 3 3) 2)
+                (make-dist-cell (make-posn 4 3) 3)
+
+                
+                (make-dist-cell (make-posn 1 4) 2)
+                (make-dist-cell (make-posn 2 4) 2)
+                (make-dist-cell (make-posn 3 4) 2)
+                (make-dist-cell (make-posn 4 4) 3)))
+              true)
+
+(check-expect (lookup-in-table
+               (build-bfs-table (make-world (empty-board 5)
+                                            (make-posn 2 2)
+                                            'playing
+                                            5)
+                                (make-posn 2 2))
+               (make-posn 1 4))
+              2)
+
 
 ;; lookup-in-table : distance-map posn -> number or '∞
 ;; looks for the distance as recorded in the table t, 
@@ -495,40 +548,123 @@
                                (make-posn 1 2))
               '∞)
 
-;; on-boundary? : posn number -> boolean
-(define (on-boundary? p board-size)
-  (or (= (posn-x p) 0)
-      (= (posn-y p) 0)
-      (= (posn-x p) (- board-size 1))
-      (= (posn-y p) (- board-size 1))))
 
-(check-expect (on-boundary? (make-posn 0 1) 13) true)
+;; on-cats-path? : world -> posn -> boolean
-(check-expect (on-boundary? (make-posn 1 0) 13) true)
+;; returns true when the posn is on the shortest path 
-(check-expect (on-boundary? (make-posn 12 1) 13) true)
+;; from the cat to the edge of the board, in the given world
-(check-expect (on-boundary? (make-posn 1 12) 13) true)
+(define (on-cats-path? w)
-(check-expect (on-boundary? (make-posn 1 1) 13) false)
+  (local [(define edge-distance-map (build-bfs-table w 'boundary))
-(check-expect (on-boundary? (make-posn 10 10) 13) false)
+          (define cat-distance-map (build-bfs-table w (world-cat w)))
+          (define cat-distance (lookup-in-table edge-distance-map 
+                                                (world-cat w)))]
+    (lambda (p)
+      (equal? (+/f (lookup-in-table cat-distance-map p)
+                   (lookup-in-table edge-distance-map p))
+              cat-distance))))
+
+(check-expect ((on-cats-path? (make-world (empty-board 5) (make-posn 1 1) 'playing 5))
+               (make-posn 1 0))
+              true)
+(check-expect ((on-cats-path? (make-world (empty-board 5) (make-posn 1 1) 'playing 5))
+               (make-posn 2 1))
+              false)
+
+;; neighbors : world (or/c 'boundary posn) -> (listof (or/c 'boundary posn))
+;; computes the neighbors of a posn, for a given board size
+(define (neighbors w)
+  (local [(define blocked (map cell-p
+                               (filter cell-blocked? 
+                                       (world-board w))))
+          (define boundary-cells (filter (lambda (p) 
+                                           (and (not (member p blocked))
+                                                (on-boundary? p (world-size w))))
+                                         (map cell-p (world-board w))))]
+    (lambda (p)
+      (cond 
+        [(member p blocked)
+         '()]
+        [(equal? p 'boundary)
+         boundary-cells]
+        [else
+         (local [(define x (posn-x p))
+                 (define y (posn-y p))
+                 (define adjacent-posns (adjacent p (world-size w)))
+                 (define in-bounds
+                   (filter (lambda (x) (in-bounds? x (world-size w)))
+                           adjacent-posns))]
+           (filter
+            (lambda (x) (not (member x blocked)))
+            (cond
+              [(equal? in-bounds adjacent-posns)
+               in-bounds]
+              [else
+               (cons 'boundary in-bounds)])))]))))
+
+(check-expect ((neighbors (empty-world 11))  (make-posn 1 1))
+              (adjacent (make-posn 1 1) 11))
+(check-expect ((neighbors (empty-world 11)) (make-posn 2 2))
+              (adjacent (make-posn 2 2) 11))
+(check-expect ((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)))
+(check-expect ((neighbors (empty-world 11)) (make-posn 1 0))
+              (list 'boundary 
+                    (make-posn 2 0)
+                    (make-posn 0 1)
+                    (make-posn 1 1)))
+(check-expect ((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 1 1))
+              '())
+(check-expect ((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 1 0))
+              (list 'boundary (make-posn 2 0) (make-posn 0 1)))
+
 
 ;; adjacent : posn number -> (listof posn)
+;; returns a list of the posns that are adjacent to 
+;; `p' on an infinite hex grid
 (define (adjacent p board-size)
   (local [(define x (posn-x p))
           (define y (posn-y p))]
-    (filter (lambda (x) (in-bounds? x board-size))
+    (cond
-            (cond
+      [(even? y)
-              [(even? y)
+       (list (make-posn (- x 1) (- y 1))
-               (list (make-posn (- x 1) (- y 1))
+             (make-posn x (- y 1))
-                     (make-posn x (- y 1))
+             (make-posn (- x 1) y)
-                     (make-posn (- x 1) y)
+             (make-posn (+ x 1) y)
-                     (make-posn (+ x 1) y)
+             (make-posn (- x 1) (+ y 1))
-                     (make-posn (- x 1) (+ y 1))
+             (make-posn x (+ y 1)))]
-                     (make-posn x (+ y 1)))]
+      [else
-              [else
+       (list (make-posn x (- y 1))
-               (list (make-posn x (- y 1))
+             (make-posn (+ x 1) (- y 1))
-                     (make-posn (+ x 1) (- y 1))
+             (make-posn (- x 1) y)
-                     (make-posn (- x 1) y)
+             (make-posn (+ x 1) y)
-                     (make-posn (+ x 1) y)
+             (make-posn x (+ y 1))
-                     (make-posn x (+ y 1))
+             (make-posn (+ x 1) (+ y 1)))])))
-                     (make-posn (+ x 1) (+ y 1)))]))))
 
 (check-expect (adjacent (make-posn 1 1) 11)
               (list (make-posn 1 0)
@@ -545,6 +681,23 @@
                     (make-posn 1 3)
                     (make-posn 2 3)))
 
+
+
+;; on-boundary? : posn number -> boolean
+(define (on-boundary? p board-size)
+  (or (= (posn-x p) 0)
+      (= (posn-y p) 0)
+      (= (posn-x p) (- board-size 1))
+      (= (posn-y p) (- board-size 1))))
+
+(check-expect (on-boundary? (make-posn 0 1) 13) true)
+(check-expect (on-boundary? (make-posn 1 0) 13) true)
+(check-expect (on-boundary? (make-posn 12 1) 13) true)
+(check-expect (on-boundary? (make-posn 1 12) 13) true)
+(check-expect (on-boundary? (make-posn 1 1) 13) false)
+(check-expect (on-boundary? (make-posn 10 10) 13) false)
+
+
 ;; in-bounds? : posn number -> boolean
 (define (in-bounds? p board-size)
   (and (<= 0 (posn-x p) (- board-size 1))
@@ -562,37 +715,29 @@
 (check-expect (in-bounds? (make-posn 10 0) 11) true)
 (check-expect (in-bounds? (make-posn 0 10) 11) false)
 
-;; min-l : (listof number-or-symbol) -> number-or-symbol
-(define (min-l ls) (foldr (lambda (x y) (min/f x y)) '∞ ls))
-(check-expect (min-l (list)) '∞)
-(check-expect (min-l (list 10 1 12)) 1)
-
 ;; <=/f : (number or '∞) (number or '∞) -> boolean
-(define (<=/f a b) (equal? a (min/f a b)))
+(define (<=/f a b)
+  (cond
+    [(equal? b '∞) true]
+    [(equal? a '∞) false]
+    [else (<= a b)]))
 (check-expect (<=/f 1 2) true)
 (check-expect (<=/f 2 1) false)
 (check-expect (<=/f '∞ 1) false)
 (check-expect (<=/f 1 '∞) true)
 (check-expect (<=/f '∞ '∞) true)
 
-;; min/f : (number or '∞) (number or '∞) -> (number or '∞)
+(define (+/f x y)
-(define (min/f x y)
   (cond
-    [(equal? x '∞) y]
+    [(or (equal? x '∞) (equal? y '∞))
-    [(equal? y '∞) x]
+     '∞]
-    [else (min x y)]))
+    [else 
-(check-expect (min/f '∞ 1) 1)
+     (+ x y)]))
-(check-expect (min/f 1 '∞) 1)
-(check-expect (min/f '∞ '∞) '∞)
-(check-expect (min/f 1 2) 1)
 
-;; add1/f : number or '∞ -> number or '∞
+(check-expect (+/f '∞ '∞) '∞)
-(define (add1/f n)
+(check-expect (+/f '∞ 1) '∞)
-  (cond
+(check-expect (+/f 1 '∞) '∞)
-    [(equal? n '∞) '∞]
+(check-expect (+/f 1 2) 3)
-    [else (add1 n)]))
-(check-expect (add1/f 1) 2)
-(check-expect (add1/f '∞) '∞)
 
 ;                                          
 ;                                          
@@ -675,7 +820,7 @@
 ;; move-cat : world -> world
 (define (move-cat world)
   (local [(define cat-position (world-cat world))
-          (define table (build-table/fast world))
+          (define table (build-bfs-table world 'boundary))
           (define neighbors (adjacent cat-position (world-size world)))
           (define next-cat-positions
             (find-best-positions neighbors
@@ -1003,38 +1148,84 @@
                                         (random (length unblocked-cells))))]
        (add-n-random-blocked-cells
         (sub1 n)
-        (map (lambda (c) (if (equal? to-block c)
+        (block-cell (cell-p to-block) all-cells)
-                             (make-cell (cell-p c) true)
-                             c))
-             all-cells)
         board-size))]))
 
+;; block-cell : posn board -> board
+(define (block-cell to-block board)
+  (map (lambda (c) (if (equal? to-block (cell-p c))
+                       (make-cell to-block true)
+                       c))
+       board))
+(check-expect (block-cell (make-posn 1 1)
+                          (list (make-cell (make-posn 0 0) false)
+                                (make-cell (make-posn 1 1) false)
+                                (make-cell (make-posn 2 2) false)))
+              (list (make-cell (make-posn 0 0) false)
+                    (make-cell (make-posn 1 1) true)
+                    (make-cell (make-posn 2 2) false)))
+
 (check-expect (add-n-random-blocked-cells 0 (list (make-cell (make-posn 0 0) true)) 10)
               (list (make-cell (make-posn 0 0) true)))
 (check-expect (add-n-random-blocked-cells 1 (list (make-cell (make-posn 0 0) false)) 10)
               (list (make-cell (make-posn 0 0) true)))
 
+;; empty-board : number -> (listof cell)
+(define (empty-board board-size)
+  (filter
+   (lambda (c)
+     (not (and (= 0 (posn-x (cell-p c)))
+               (or (= 0 (posn-y (cell-p c)))
+                   (= (- board-size 1)
+                      (posn-y (cell-p c)))))))
+   (append-all
+    (build-list
+     board-size
+     (lambda (i)
+       (build-list
+        board-size
+        (lambda (j) 
+          (make-cell (make-posn i j) 
+                     false))))))))
+
+(check-expect (empty-board 3)
+              (list
+               (make-cell (make-posn 0 1) false)
+               (make-cell (make-posn 1 0) false)
+               (make-cell (make-posn 1 1) false)
+               (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)))
+
+;; empty-world : number -> world
+(define (empty-world board-size)
+  (make-world (empty-board board-size)
+              (make-posn (quotient board-size 2)
+                         (quotient board-size 2))
+              'playing
+              board-size))
+
+(check-expect (empty-world 3)
+              (make-world (list
+                           (make-cell (make-posn 0 1) false)
+                           (make-cell (make-posn 1 0) false)
+                           (make-cell (make-posn 1 1) false)
+                           (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))
+
 (define dummy
   (local
     [(define board-size 11)
      (define initial-board
        (add-n-random-blocked-cells
         6
-        (filter
+        (empty-board board-size)
-         (lambda (c)
-           (not (and (= 0 (posn-x (cell-p c)))
-                     (or (= 0 (posn-y (cell-p c)))
-                         (= (- board-size 1)
-                            (posn-y (cell-p c)))))))
-         (append-all
-          (build-list
-           board-size
-           (lambda (i)
-             (build-list
-              board-size
-              (lambda (j) 
-                (make-cell (make-posn i j) 
-                           false)))))))
         board-size))
      (define initial-world
        (make-world initial-board
@@ -1043,7 +1234,7 @@
                    'playing
                    board-size))]
     
-    (and ;((lambda (x) true) (time (build-table initial-world))) ;((lambda (x) true) (time (build-table/fast initial-world)))
+    (and 
      (big-bang (world-width board-size)
                (world-height board-size)
                1 

collects/games/chat-noir/hash.ss

@@ -1,2 +1,8 @@
 #lang scheme/base
-(provide make-hash hash-set! hash-ref hash-map)
+(provide make-immutable-hash/list-init
+         hash-set hash-ref hash-map)
+
+(define (make-immutable-hash/list-init [init '()])
+  (make-immutable-hash
+   (map (λ (x) (cons (car x) (cadr x)))
+        init)))