|
|
|
|
#lang br/quicklang ;; http://adventofcode.com/2016/day/17
|
|
|
|
|
(require openssl/md5 sugar/cache)
|
|
|
|
|
(provide read-syntax
|
|
|
|
|
(rename-out [mb #%module-begin]))
|
|
|
|
|
|
|
|
|
|
(define (read-syntax path port)
|
|
|
|
|
(strip-bindings
|
|
|
|
|
#`(module mod "lang.rkt"
|
|
|
|
|
#,(string-trim (port->string port)))))
|
|
|
|
|
|
|
|
|
|
(define-macro (mb STR)
|
|
|
|
|
#'(#%module-begin
|
|
|
|
|
(displayln (solve-shortest STR))
|
|
|
|
|
(displayln (solve-longest STR))))
|
|
|
|
|
|
|
|
|
|
(define (path->dirs path)
|
|
|
|
|
(regexp-match* #rx"[UDLR]" path))
|
|
|
|
|
|
|
|
|
|
(define (on-grid? pos)
|
|
|
|
|
(and (<= 0 (real-part pos) 3)
|
|
|
|
|
(<= 0 (imag-part pos) 3)))
|
|
|
|
|
|
|
|
|
|
(define/caching (follow-path path)
|
|
|
|
|
(define result (regexp-match #rx"^(.*)([UDLR])$" path))
|
|
|
|
|
(define end
|
|
|
|
|
(cond
|
|
|
|
|
[result
|
|
|
|
|
(match-define (list _ prefix suffix) result)
|
|
|
|
|
(+ (follow-path prefix) (case suffix
|
|
|
|
|
[("D") +i]
|
|
|
|
|
[("U") -i]
|
|
|
|
|
[("L") -1]
|
|
|
|
|
[("R") 1]))]
|
|
|
|
|
[else 0]))
|
|
|
|
|
(and (on-grid? end) end))
|
|
|
|
|
|
|
|
|
|
(define/caching (get-hash str)
|
|
|
|
|
(md5 (open-input-string str)))
|
|
|
|
|
|
|
|
|
|
(define (take-step path)
|
|
|
|
|
(define hash (get-hash path))
|
|
|
|
|
(define prefix (car (regexp-match #rx"^...." hash)))
|
|
|
|
|
(define possible-dirs
|
|
|
|
|
(for/list ([dir (in-list (list "U" "D" "L" "R"))]
|
|
|
|
|
[c (in-string prefix)]
|
|
|
|
|
#:when (member c '(#\b #\c #\d #\e #\f)))
|
|
|
|
|
dir))
|
|
|
|
|
(for*/list ([dir (in-list possible-dirs)]
|
|
|
|
|
[path+dir (in-value (string-append path dir))]
|
|
|
|
|
#:when (follow-path path+dir))
|
|
|
|
|
path+dir))
|
|
|
|
|
|
|
|
|
|
(define vault 3+3i)
|
|
|
|
|
|
|
|
|
|
(define (solve-shortest str)
|
|
|
|
|
(let loop ([paths (list str)])
|
|
|
|
|
(define stepped-paths (append-map take-step paths))
|
|
|
|
|
(if (empty? stepped-paths)
|
|
|
|
|
'no-solution
|
|
|
|
|
(or (for/first ([sp (in-list stepped-paths)]
|
|
|
|
|
#:when (= vault (follow-path sp)))
|
|
|
|
|
(apply string-append (path->dirs sp)))
|
|
|
|
|
(loop stepped-paths)))))
|
|
|
|
|
|
|
|
|
|
(define (solve-longest str)
|
|
|
|
|
(length
|
|
|
|
|
(path->dirs
|
|
|
|
|
(argmax string-length
|
|
|
|
|
(let loop ([paths (list str)][vault-paths empty][i 0])
|
|
|
|
|
(cond
|
|
|
|
|
[(empty? paths) vault-paths]
|
|
|
|
|
[else
|
|
|
|
|
(define stepped-paths (append-map take-step paths))
|
|
|
|
|
(define-values (new-vault-paths other-paths)
|
|
|
|
|
(partition (λ (sp) (= vault (follow-path sp))) stepped-paths))
|
|
|
|
|
(loop other-paths (if (pair? new-vault-paths) new-vault-paths vault-paths) (add1 i))]))))))
|
