1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
-
-
-
-
+
+
+
+
+
-
+
-
+
-
+
-
-
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
+
+
-
+
+
+
-
+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
+
-
-
-
+
-
-
+
-
-
+
-
+
-
-
+
-
-
+
|
#lang debug racket/base
(require racket/match
racket/function
racket/list
racket/vector
racket/set
threading)
(struct fighter (x y hp) #:transparent)
;; Good ol’ positions.
(struct posn (x y) #:transparent)
;; The concept of “reading order” is an important one in this puzzle. We can use
;; this comparison function with `sort` to ensure a list of positions is sorted
;; according to how you’d encounter them reading left-to-right, top to bottom.
;; This is where I mention that this program views 0,0 as “top left”.
(define (posn<? p1 p2)
(match-define (posn x1 y1) p1)
(match-define (posn x2 y2) p2)
(or (< y1 y2)
(and (<= y1 y2)
(<= x1 x2))))
;; Keeping track of elves and gnomes. We’ll have separate lists for each group.
;; Making this a subtype of posn means we can pass a fighter to any function
;; that expects a posn.
(struct fighter (hp) #:super struct:posn #:transparent)
;; “The grid…a digital frontier. I tried to picture clusters of information as
;; they moved through the computer. What did they look like? …I kept dreaming
;; of a world I thought I’d never see. And then one day…I got in.”
;; https://youtu.be/QBYr0k8dOtw?t=24
(struct grid (vec rows cols) #:transparent)
;; Our “grid” is, behind the scenes, a one-dimensional vector with length ROWS*COLS.
;; This function translates an x,y pair
(define (coords->index g x y)
(+ (* (grid-cols g) y) x))
;; Create a grid from a list of strings each representing a row, filling each
;; spot with the corresponding character in the string
(define (make-grid line-strs)
(define (lines->grid line-strs)
(define row-count (length line-strs))
(define col-count (string-length (first line-strs)))
(grid
(apply vector-append
(map list->vector
(map string->list line-strs)))
row-count
col-count))
(grid (apply vector-append
(map list->vector
(map string->list line-strs)))
row-count
col-count))
(define test-map
(make-grid
(lines->grid
'("#######"
"#E..G.#"
"#...#.#"
"#.G.#G#"
"#######")))
(module+ test
;; Grids and Positions: put them together
(require rackunit))
;; Reference the value at given position in a grid
(define (grid-ref g x y)
(vector-ref (grid-vec g) (+ (* (grid-cols g) y) x)))
(define (grid-ref g p)
(match-define (posn x y) p)
(vector-ref (grid-vec g) (coords->index g x y)))
;; Change the value at given position
(define (grid-clear-at? g p #:goal [goal #f])
(match-define (posn x y) p)
(or #R (equal? #R goal #R p)
(equal? (grid-ref g x y) #\.)))
(define (grid-mark! g pos v)
(match-define (posn x y) pos)
(vector-set! (grid-vec g) (coords->index g x y) v))
;; Used to determine if a fighter could move into a given spot.
;; Anything besides "." counts as an obstruction (incl. other fighters)
(define (grid-clear-at? g p)
(equal? (grid-ref g p) #\.))
;; Make a blank grid of the same dimensions, for use in making “path grids” (see
;; further below)
(define (copy-blank-grid g)
(match-define (grid _ rows cols) g)
(grid (make-vector (* rows cols) #f) rows cols))
;; (For debugging) Represent the grid as a square of single-character values
(define (display-grid g)
(define (display-grid g [g2 #f])
(define grid-size (* (grid-cols g) (grid-rows g)))
(display
(apply string-append
(for/fold ([lst '()]
#:result (reverse (cons "\n" lst)))
([val (in-vector (grid-vec g))]
[i (in-naturals 1)])
(define ch
(cond [(number? val) (number->string (modulo val 10))]
[(boolean? val) "-"]
[(string? val) val]
[else (format "~a" val)]))
(cond [(equal? 0 (modulo i (grid-cols g)))
(cond [(and (equal? 0 (modulo i (grid-cols g)))
(< i grid-size))
(cons "\n" (cons ch lst))]
[else (cons ch lst)])))))
;; Is point p inside grid g? Film at 11
(define (posn-outside-grid? p g)
(define (inside-grid? g p)
(match-define (posn px py) p)
(or (< px 0)
(< py 0)
(> px (- (grid-rows g) 1))
(> py (- (grid-cols g) 1))))
(and (>= px 0)
(>= py 0)
(< px (grid-rows g))
(< py (grid-cols g))))
(define (grid-mark! g pos v)
(match-define (posn x y) pos)
(vector-set! (grid-vec g) (+ (* (grid-cols g) y) x) v))
(define (neighbor-coords pos)
;; Get a list of a positions neighboring points, ensuring none are out of bounds
(define (neighbor-coords g pos)
(match-define (posn x y) pos)
(filter (curry inside-grid? g)
(map (lambda (lst) (apply posn lst))
`((,(- x 1) ,y)
(,x ,(+ y 1))
(,(+ x 1) ,y)
(,x ,(- y 1)))))
(map (lambda (lst) (apply posn lst))
`((,(- x 1) ,y)
(,x ,(+ y 1))
(,(+ x 1) ,y)
(,x ,(- y 1))))))
;; Get all the EMPTY neighboring points of a given spot OR list of spots.
;; If a (listof posn?) is passed, ensures the returned list does not include
;; any of the original positions.
(define (free-neighbors-at world pos #:goal [goal #f])
(filter (curry grid-clear-at? world #:goal goal) (neighbor-coords pos)))
(define (free-neighbors-at world pos)
(cond [(posn? pos)
(~> (neighbor-coords world pos)
(filter (curry grid-clear-at? world) _))]
[(list? pos)
(~> (map (curry neighbor-coords world) pos)
flatten
(filter (curry grid-clear-at? world) _)
(set-subtract pos)
remove-duplicates)]))
;; “Path grids” are a specific use of grids where points are marked with integers
;; indicated their distance from an origin point.
;; A point has been checked when it is not equal to #false.
(define (not-yet-checked? pmap iter-num pos)
(define (not-yet-checked? pmap pos)
(match-define (posn x y) pos)
(let ([val (grid-ref pmap x y)])
(not (grid-ref pmap pos)))
(or (boolean? val)
(and (number? val)
(> val iter-num)))))
;; Find the most direct path(s) to a fighter from an end-position
(define (path-grid world f end-pos)
(define f-pos (posn (fighter-x f) (fighter-y f)))
(define result-grid (copy-blank-grid world))
(define goal-pts (free-neighbors-at world f))
(grid-mark! result-grid end-pos 0)
(display-grid result-grid)
(let loop ([to-check (list end-pos)]
(let loop ([pts-to-check (list end-pos)]
[i 1])
(define new-1 (map (curry free-neighbors-at world #:goal f-pos) #R to-check))
(define new-coords (~> (free-neighbors-at world pts-to-check)
(define new-2 (remove-duplicates (flatten #R new-1)))
(define new-coords (filter (curry not-yet-checked? result-grid i) #R new-2))
(filter (curry not-yet-checked? result-grid) _)))
(for-each (lambda (p) (grid-mark! result-grid p i)) new-coords)
(display-grid result-grid)
(cond
[(member f-pos new-coords) result-grid]
[(not (empty? (set-intersect new-coords goal-pts))) result-grid]
[(empty? new-coords) #f]
[else (loop new-coords (+ 1 i))])))
|