day21

2016/day19/lang.rkt

@@ -1,4 +1,4 @@
-#lang br/quicklang ;; http://adventofcode.com/2016/day/18
+#lang br/quicklang ;; http://adventofcode.com/2016/day/19
 (provide read-syntax
          (rename-out [mb #%module-begin]))
 

2016/day20/lang.rkt

@@ -1,4 +1,4 @@
-#lang br/quicklang ;; http://adventofcode.com/2016/day/18
+#lang br/quicklang ;; http://adventofcode.com/2016/day/20
 (provide read-syntax
          cons
          (rename-out [mb #%module-begin]))

2016/day21/input.rkt

@@ -0,0 +1,102 @@
+#lang reader "lang.rkt"
+abcdefgh
+swap position 5 with position 6
+reverse positions 1 through 6
+rotate right 7 steps
+rotate based on position of letter c
+rotate right 7 steps
+reverse positions 0 through 4
+swap letter f with letter h
+reverse positions 1 through 2
+move position 1 to position 0
+rotate based on position of letter f
+move position 6 to position 3
+reverse positions 3 through 6
+rotate based on position of letter c
+rotate based on position of letter b
+move position 2 to position 4
+swap letter b with letter d
+move position 1 to position 6
+move position 7 to position 1
+swap letter f with letter c
+move position 2 to position 3
+swap position 1 with position 7
+reverse positions 3 through 5
+swap position 1 with position 4
+move position 4 to position 7
+rotate right 4 steps
+reverse positions 3 through 6
+move position 0 to position 6
+swap position 3 with position 5
+swap letter e with letter h
+rotate based on position of letter c
+swap position 4 with position 7
+reverse positions 0 through 5
+rotate right 5 steps
+rotate left 0 steps
+rotate based on position of letter f
+swap letter e with letter b
+rotate right 2 steps
+rotate based on position of letter c
+swap letter a with letter e
+rotate left 4 steps
+rotate left 0 steps
+move position 6 to position 7
+rotate right 2 steps
+rotate left 6 steps
+rotate based on position of letter d
+swap letter a with letter b
+move position 5 to position 4
+reverse positions 0 through 7
+rotate left 3 steps
+rotate based on position of letter e
+rotate based on position of letter h
+swap position 4 with position 6
+reverse positions 4 through 5
+reverse positions 5 through 7
+rotate left 3 steps
+move position 7 to position 2
+move position 3 to position 4
+swap letter b with letter d
+reverse positions 3 through 4
+swap letter e with letter a
+rotate left 4 steps
+swap position 3 with position 4
+swap position 7 with position 5
+rotate right 1 step
+rotate based on position of letter g
+reverse positions 0 through 3
+swap letter g with letter b
+rotate based on position of letter b
+swap letter a with letter c
+swap position 0 with position 2
+reverse positions 1 through 3
+rotate left 7 steps
+swap letter f with letter a
+move position 5 to position 0
+reverse positions 1 through 5
+rotate based on position of letter d
+rotate based on position of letter c
+rotate left 2 steps
+swap letter b with letter a
+swap letter f with letter c
+swap letter h with letter f
+rotate based on position of letter b
+rotate left 3 steps
+swap letter b with letter h
+reverse positions 1 through 7
+rotate based on position of letter h
+swap position 1 with position 5
+rotate left 1 step
+rotate based on position of letter h
+reverse positions 0 through 1
+swap position 5 with position 7
+reverse positions 0 through 2
+reverse positions 1 through 3
+move position 1 to position 4
+reverse positions 1 through 3
+rotate left 1 step
+swap position 4 with position 1
+move position 1 to position 3
+rotate right 2 steps
+move position 0 to position 5

2016/day21/lang.rkt

@@ -0,0 +1,80 @@
+#lang br/quicklang ;; http://adventofcode.com/2016/day/21
+(provide read-syntax
+         (rename-out [mb #%module-begin]))
+
+(define (read-syntax path port)
+  (strip-bindings
+   (let ([lines (string-split (port->string port) "\n")])
+     #`(module mod "lang.rkt"
+         #,(car lines)
+         #,@(for/list ([args (in-list (map string-split (cdr lines)))])
+              `(inst ,@(map (λ(arg) (or (string->number arg) arg)) args)))))))
+
+(define-macro (mb CODE . INSTS)
+  #'(#%module-begin
+     (define (explode str) (regexp-match* #rx"." str))
+     (define (scramble code)
+       (apply string-append
+              (vector->list
+               (for/fold ([code (apply vector (explode code))])
+                         ([proc (in-list (list . INSTS))])
+                 (proc code)))))
+     (scramble CODE)
+     (for*/first ([uplist (in-permutations (explode "fbgdceah"))]
+                  [up (in-value (string-join uplist ""))]
+                  #:when (equal? (scramble up) "fbgdceah"))
+       up)))
+
+(define-macro-cases inst
+  [(_ "swap" "position" X "with" "position" Y) #'(swap-position X Y)]
+  [(_ "swap" "letter" X "with" "letter" Y) #'(swap-letter X Y)]
+  [(_ "reverse" "positions" X "through" Y) #'(reverse-letters X Y)]
+  [(_ "rotate" DIR NUM _) #'(rotate DIR NUM)]
+  [(_ "move" "position" X "to" "position" Y) #'(move X Y)]
+  [(_ "rotate" "based" "on" "position" "of" "letter" X) #'(rotate-letter X)])
+(provide inst)
+
+(define (swap-position xidx yidx)
+  (λ(v)
+    (define tmp (vector-ref v xidx))
+    (vector-set*! v xidx (vector-ref v yidx) yidx tmp)
+    v))
+
+(define (swap-letter x y)
+  (λ(v) ((swap-position (vector-member x v) (vector-member y v)) v)))
+
+(define (reverse-letters xidx yidx)
+  (λ(v)
+    (define letter-idxs (range xidx (add1 yidx)))
+    (define letters
+      (for/list ([idx (in-list letter-idxs)])
+        (vector-ref v idx)))
+    (for ([idx (in-list (reverse letter-idxs))]
+          [letter (in-list letters)])
+      (vector-set! v idx letter))
+    v))
+
+(require sugar/list)
+(define (rotate dir num)
+  (λ(v)
+    (list->vector
+     ((if (equal? "left" dir)
+          shift-left-cycle
+          shift-cycle) (vector->list v) num))))
+
+(define (rotate-letter x)
+  (λ(v)
+    (define xidx (vector-member x v))
+    (define rotval (+ 1 xidx (if (>= xidx 4) 1 0)))
+    ((rotate "right" rotval) v)))
+
+(define (move xidx yidx)
+  (λ(v)
+    (define xs (vector->list v))
+    (define-values (head tail) (split-at xs xidx))
+    (define x (car tail))
+    (define new-xs (append head (cdr tail)))
+    (define-values (newhead newtail) (split-at new-xs yidx))
+    (list->vector (append newhead (list x) newtail))))
+    
+

2016/day21/test.rkt

@@ -0,0 +1,10 @@
+#lang reader "lang.rkt"
+abcde
+swap position 4 with position 0
+swap letter d with letter b
+reverse positions 0 through 4
+rotate left 1 step
+move position 1 to position 4
+move position 3 to position 0
+rotate based on position of letter b
+rotate based on position of letter d