From efc0c1bcd6f76c14cf051a95986aaa0fac128b15 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Mon, 25 Dec 2017 16:36:11 -0800
Subject: [PATCH] d22

---
 2017/d22/main.rkt  | 63 ++++++++++++++++++++++++++++++++++++++++++++++
 2017/d22/star1.rkt | 26 +++++++++++++++++++
 2017/d22/star2.rkt | 26 +++++++++++++++++++
 2017/d22/test1.rkt |  4 +++
 2017/d22/test2.rkt |  4 +++
 5 files changed, 123 insertions(+)
 create mode 100644 2017/d22/main.rkt
 create mode 100644 2017/d22/star1.rkt
 create mode 100644 2017/d22/star2.rkt
 create mode 100644 2017/d22/test1.rkt
 create mode 100644 2017/d22/test2.rkt

diff --git a/2017/d22/main.rkt b/2017/d22/main.rkt
new file mode 100644
index 0000000..e9f8d1a
--- /dev/null
+++ b/2017/d22/main.rkt
@@ -0,0 +1,63 @@
+#lang br/quicklang
+(require "../helper.rkt")
+(provide read-syntax (rename-out [#%mb #%module-begin]) ★ ★★)
+
+(define (read-syntax path port)
+  (define lines (port->lines port))
+  (strip-context #`(module mod "main.rkt"
+                     #,@(for/list ([datum (in-port read (open-input-string (car lines)))])
+                          datum)
+                     #,@(cdr lines))))
+
+(define-macro (#%mb STARS LINE ...)
+  #'(#%module-begin
+     (time (STARS (list LINE ...)))))
+
+(define (infect lines bursts #:weak-mode [weak-mode? #f])
+  (define chars (make-hasheqv))
+  (define origin-adjust (/ (sub1 (string-length (car lines))) 2))
+  (for* ([(line lidx) (in-indexed lines)]
+         [(c cidx) (in-indexed (string->list line))])
+    (define key (+ (- lidx origin-adjust) (* +i (- cidx origin-adjust))))
+    (hash-set! chars key c))
+  
+  (define turn-left +i) (define turn-right -i)
+  
+  (define-macro (define-state ID CHAR)
+    (with-pattern ([ID? (suffix-id #'ID "?")]
+                   [SET-ID (prefix-id "set-" #'ID)])
+      #'(begin (define ID CHAR)
+               (define (SET-ID x) (hash-set! chars x ID))
+               (define (ID? x) (eqv? (hash-ref! chars x #\.) ID)))))
+  (define-state clean #\.)
+  (define-state infected #\#)
+  (define-state weakened #\W)
+  (define-state flagged #\F)
+  
+  (for/fold ([here 0]
+             [dir -1]
+             [infections 0]
+             #:result infections)
+            ([burst (in-range bursts)])
+    (match here
+      [(? infected?)
+       (define next-dir (* dir turn-right))
+       ((if weak-mode? set-flagged set-clean) here)
+       (values (+ here next-dir) next-dir infections)]
+      [(? clean?)
+       (define next-dir (* dir turn-left))
+       ((if weak-mode? set-weakened set-infected) here)
+       (values (+ here next-dir) next-dir ((if weak-mode? values add1) infections))]
+      [(? weakened?)
+       (define next-dir dir)
+       (set-infected here)
+       (values (+ here next-dir) next-dir (add1 infections))]
+      [(? flagged?)
+       (define next-dir (- dir))
+       (set-clean here)
+       (values (+ here next-dir) next-dir infections)])))
+
+(define (★ lines) (infect lines 10000))
+
+(define (★★ lines) (infect lines 10000000 #:weak-mode #t))
+                                   
diff --git a/2017/d22/star1.rkt b/2017/d22/star1.rkt
new file mode 100644
index 0000000..e34215a
--- /dev/null
+++ b/2017/d22/star1.rkt
@@ -0,0 +1,26 @@
+#lang reader "main.rkt" ★ ; 5411
+#.#.#.##.#.##.###.#.###.#
+.#..#.....#..#######.##.#
+......###..##..###..#...#
+##....#.#.#....#..#..#..#
+#..#....#.##.#.#..#..#.#.
+..##..##.##..##...#...###
+..#.#....#..####.##.##...
+###...#.#...#.######...#.
+..#####...###..#####.#.##
+...#..#......####.##..#.#
+#...##..#.#####...#.##...
+..#.#.###.##.##....##.###
+##.##...###....#######.#.
+#.#...#.#..#.##..##..##.#
+.#...###...#..#..####....
+####...#...##.####..#.#..
+......#.....##.#.##....##
+###.......####..##.#.##..
+....###.....##.##..###.#.
+.##..##.#.###.###..#.###.
+..#..##.######.##........
+#..#.#..#.###....##.##..#
+.##.#.#...######...##.##.
+##..#..#..##.#.#..#..####
+#######.#.######.#.....##
\ No newline at end of file
diff --git a/2017/d22/star2.rkt b/2017/d22/star2.rkt
new file mode 100644
index 0000000..bf4ef2f
--- /dev/null
+++ b/2017/d22/star2.rkt
@@ -0,0 +1,26 @@
+#lang reader "main.rkt" ★★ ; 2511416
+#.#.#.##.#.##.###.#.###.#
+.#..#.....#..#######.##.#
+......###..##..###..#...#
+##....#.#.#....#..#..#..#
+#..#....#.##.#.#..#..#.#.
+..##..##.##..##...#...###
+..#.#....#..####.##.##...
+###...#.#...#.######...#.
+..#####...###..#####.#.##
+...#..#......####.##..#.#
+#...##..#.#####...#.##...
+..#.#.###.##.##....##.###
+##.##...###....#######.#.
+#.#...#.#..#.##..##..##.#
+.#...###...#..#..####....
+####...#...##.####..#.#..
+......#.....##.#.##....##
+###.......####..##.#.##..
+....###.....##.##..###.#.
+.##..##.#.###.###..#.###.
+..#..##.######.##........
+#..#.#..#.###....##.##..#
+.##.#.#...######...##.##.
+##..#..#..##.#.#..#..####
+#######.#.######.#.....##
\ No newline at end of file
diff --git a/2017/d22/test1.rkt b/2017/d22/test1.rkt
new file mode 100644
index 0000000..3281444
--- /dev/null
+++ b/2017/d22/test1.rkt
@@ -0,0 +1,4 @@
+#lang reader "main.rkt" ★ ; 5587
+..#
+#..
+...
diff --git a/2017/d22/test2.rkt b/2017/d22/test2.rkt
new file mode 100644
index 0000000..9363685
--- /dev/null
+++ b/2017/d22/test2.rkt
@@ -0,0 +1,4 @@
+#lang reader "main.rkt" ★★ ; 2511944
+..#
+#..
+...