end the barbarism

master
Matthew Butterick 5 years ago
parent 04f42d786c
commit 35ee60c37c

@ -13,7 +13,7 @@
(define g (for/fold ([g (grid 50 6)])
([inst (in-list (list INST ...))])
(inst g)))
(for-each displayln (map (λ(gr) (map (λ(gri) (if (= gri 1) "X" " ")) gr)) g))
(for-each displayln (map (λ (gr) (map (λ (gri) (if (= gri 1) "X" " ")) gr)) g))
(apply + (flatten g))))
(require (for-syntax racket/string))

@ -27,15 +27,15 @@
(if (void? move) 1 move)))))))
(define-macro (cpy X Y)
#'(λ(regs)
#'(λ (regs)
(define val (if (number? 'X) 'X (hash-ref regs 'X)))
(hash-set! regs 'Y val)))
(define-macro (inc X) #'(λ(regs) (hash-update! regs 'X add1)))
(define-macro (inc X) #'(λ (regs) (hash-update! regs 'X add1)))
(define-macro (dec X) #'(λ(regs) (hash-update! regs 'X sub1)))
(define-macro (dec X) #'(λ (regs) (hash-update! regs 'X sub1)))
(define-macro (jnz X Y)
#'(λ(regs)
#'(λ (regs)
(when (not (zero? (if (number? 'X) 'X (hash-ref regs 'X))))
Y)))

@ -50,7 +50,7 @@
(add1 count)))))
(define (make-open-pred num)
(λ(pt)
(λ (pt)
(define col (real-part pt))
(define row (imag-part pt))
(define sum

@ -72,5 +72,5 @@
[else
(define stepped-paths (append-map take-step paths))
(define-values (new-vault-paths other-paths)
(partition (λ(sp) (= vault (follow-path sp))) stepped-paths))
(partition (λ (sp) (= vault (follow-path sp))) stepped-paths))
(loop other-paths (if (pair? new-vault-paths) new-vault-paths vault-paths) (add1 i))]))))))

@ -10,7 +10,7 @@
(define-macro (mb STR)
#'(#%module-begin
(define (traps cs)
(length (filter (λ(c) (char=? #\. c)) cs)))
(length (filter (λ (c) (char=? #\. c)) cs)))
(let loop ([cs (string->list STR)]
[count (traps (string->list STR))]
[i 0])

@ -8,7 +8,7 @@
#`(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)))))))
`(inst ,@(map (λ (arg) (or (string->number arg) arg)) args)))))))
(define-macro (mb CODE . INSTS)
#'(#%module-begin
@ -35,16 +35,16 @@
(provide inst)
(define (swap-position xidx yidx)
(λ(v)
(λ (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)))
(λ (v) ((swap-position (vector-member x v) (vector-member y v)) v)))
(define (reverse-letters xidx yidx)
(λ(v)
(λ (v)
(define letter-idxs (range xidx (add1 yidx)))
(define letters
(for/list ([idx (in-list letter-idxs)])
@ -56,20 +56,20 @@
(require sugar/list)
(define (rotate dir num)
(λ(v)
(λ (v)
(list->vector
((if (equal? "left" dir)
shift-left-cycle
shift-cycle) (vector->list v) num))))
(define (rotate-letter x)
(λ(v)
(λ (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)
(λ (v)
(define xs (vector->list v))
(define-values (head tail) (split-at xs xidx))
(define x (car tail))

@ -18,7 +18,7 @@
(define-macro (node NAME _ USED AVAIL _)
#'($node
(apply (λ(r i) (+ (string->number r)
(apply (λ (r i) (+ (string->number r)
(* (string->number i) +i))) (regexp-match* #px"\\d+" NAME))
(string->number (string-trim USED "T"))
(string->number (string-trim AVAIL "T"))))

@ -33,50 +33,50 @@
(if (void? move) 1 move)))))))
(define-macro (make-tgl-base X)
#'(λ(regs)
#'(λ (regs)
(current-toggles
((if (member X (current-toggles))
remove
cons) X (current-toggles)))))
(define-macro (tgl X)
#'(λ(regs)
#'(λ (regs)
((if (toggled?)
(make-inc-base X)
(make-tgl-base X)) regs)))
(define-macro (make-cpy-base X Y)
#'(λ(regs)
#'(λ (regs)
(define val (if (number? 'X) 'X (hash-ref regs 'X)))
(hash-set! regs 'Y val)))
(define-macro (cpy X Y)
#'(λ(regs)
#'(λ (regs)
((if (toggled?)
(make-jnz-base X Y)
(make-cpy-base X Y)) regs)))
(define-macro (make-dec-base X) #'(λ(regs) (hash-update! regs 'X sub1)))
(define-macro (make-inc-base X) #'(λ(regs) (hash-update! regs 'X add1)))
(define-macro (make-dec-base X) #'(λ (regs) (hash-update! regs 'X sub1)))
(define-macro (make-inc-base X) #'(λ (regs) (hash-update! regs 'X add1)))
(define-macro (inc X) #'(λ(regs)
(define-macro (inc X) #'(λ (regs)
((if (toggled?)
(make-dec-base X)
(make-inc-base X)) regs)))
(define-macro (dec X) #'(λ(regs)
(define-macro (dec X) #'(λ (regs)
((if (toggled?)
(make-inc-base X)
(make-dec-base X)) regs)))
(define-macro (make-jnz-base X Y)
#'(λ(regs)
#'(λ (regs)
(when (not (zero? (if (number? 'X) 'X (hash-ref regs 'X))))
Y)))
(define-macro (jnz X Y)
#'(λ(regs)
#'(λ (regs)
((if (toggled?)
(make-copy-base X Y)
(make-jnz-base X Y)) regs)))

@ -30,19 +30,19 @@
(add1 count)))))
(define-macro (cpy X Y)
#'(λ(regs)
#'(λ (regs)
(define val (if (number? 'X) 'X (hash-ref regs 'X)))
(hash-set! regs 'Y val)))
(define-macro (inc X) #'(λ(regs) (hash-update! regs 'X add1)))
(define-macro (inc X) #'(λ (regs) (hash-update! regs 'X add1)))
(define-macro (dec X) #'(λ(regs) (hash-update! regs 'X sub1)))
(define-macro (dec X) #'(λ (regs) (hash-update! regs 'X sub1)))
(define-macro (jnz X Y)
#'(λ(regs)
#'(λ (regs)
(when (not (zero? (if (number? 'X) 'X (hash-ref regs 'X))))
Y)))
(define-macro (out X)
#'(λ(regs)
#'(λ (regs)
(print (hash-ref regs 'X))))

@ -29,7 +29,7 @@ The building has an indefinite number of floors in both directions. So the ultim
(define down-char #\))
(define (make-matcher c)
(λ(str) (length (regexp-match* (regexp (format "\\~a" c)) str))))
(λ (str) (length (regexp-match* (regexp (format "\\~a" c)) str))))
(define get-ups (make-matcher up-char))
(define get-downs (make-matcher down-char))
(define (get-destination str) (- (get-ups str) (get-downs str)))]

@ -32,7 +32,7 @@ Each instruction consists of two pieces. First, an operation: either @italic{tu
(case action
[("turn on") (thunk* 1)]
[("turn off") (thunk* 0)]
[else (λ(bulb) (if (= bulb 1) 0 1))]))
[else (λ (bulb) (if (= bulb 1) 0 1))]))
(list* (action->bulb-func (string-trim action))
(map string->number coordinates)))
@ -85,9 +85,9 @@ This part is the same as the last, except we change the definitions of our bulb
(define (action->bulb-func action)
(case action
[("turn on") (λ(bulb) (add1 bulb))]
[("turn off") (λ(bulb) (max 0 (sub1 bulb)))]
[else (λ(bulb) (+ bulb 2))]))
[("turn on") (λ (bulb) (add1 bulb))]
[("turn off") (λ (bulb) (max 0 (sub1 bulb)))]
[else (λ (bulb) (+ bulb 2))]))
(list* (action->bulb-func (string-trim action))
(map string->number coordinates)))
@ -117,16 +117,16 @@ Since the only part that changes between the solutions is the bulb functions, we
(map string->number coordinates))))
(define q1-bulb-func-converter
(λ(action) (case action
(λ (action) (case action
[("turn on") (thunk* 1)]
[("turn off") (thunk* 0)]
[else (λ(bulb) (if (= bulb 1) 0 1))])))
[else (λ (bulb) (if (= bulb 1) 0 1))])))
(define q2-bulb-func-converter
(λ(action) (case action
[("turn on") (λ(bulb) (add1 bulb))]
[("turn off") (λ(bulb) (max 0 (sub1 bulb)))]
[else (λ(bulb) (+ bulb 2))])))
(λ (action) (case action
[("turn on") (λ (bulb) (add1 bulb))]
[("turn off") (λ (bulb) (max 0 (sub1 bulb)))]
[else (λ (bulb) (+ bulb 2))])))
]
@section{Testing Day 6}

@ -53,7 +53,7 @@ One gotcha when using syntax transformers is that identifiers introduced by a tr
(syntax-case stx ()
[(_)
(let* ([input-strings (file->lines "day07-input.txt")]
[wire-strings (map (λ(str) (format "(wire ~a)" str)) input-strings)]
[wire-strings (map (λ (str) (format "(wire ~a)" str)) input-strings)]
[wire-datums (map (compose1 read open-input-string) wire-strings)])
(datum->syntax stx `(begin ,@wire-datums)))]))
@ -97,7 +97,7 @@ These next definitions use @racket[define-syntax-rule] as a shortcut, which is a
(define-16bit AND bitwise-and)
(define-16bit OR bitwise-ior)
(define-16bit LSHIFT arithmetic-shift)
(define-16bit RSHIFT (λ(x y) (arithmetic-shift x (- y))))
(define-16bit RSHIFT (λ (x y) (arithmetic-shift x (- y))))
(define-16bit NOT bitwise-not)]

@ -31,7 +31,7 @@ The second part of the puzzle is just going to change the number of iterations.
(define digit-runs (regexp-match* #px"(\\d)\\1*" start))
(string-append*
(map ~a
(append-map (λ(digit-run)
(append-map (λ (digit-run)
(list (string-length digit-run)
(substring digit-run 0 1)))
digit-runs)))))

@ -30,7 +30,7 @@ As in @secref{Day_7}, we'll use @iracket[define-syntax] to set up the reindeer f
[(_)
(let* ([input-strings (file->lines "day14-input.txt")]
[reindeer-strings
(map (λ(str) (format "(reindeer ~a)" (string-downcase str))) input-strings)]
(map (λ (str) (format "(reindeer ~a)" (string-downcase str))) input-strings)]
[reindeer-datums
(map (compose1 read open-input-string) reindeer-strings)])
(datum->syntax stx `(begin ,@reindeer-datums)))]))
@ -57,7 +57,7 @@ As in @secref{Day_7}, we'll use @iracket[define-syntax] to set up the reindeer f
@chunk[<day14-q1>
(define (q1)
(define seconds-to-travel 2503)
(apply max (map (λ(deer-func) (deer-func seconds-to-travel))
(apply max (map (λ (deer-func) (deer-func seconds-to-travel))
(list dasher dancer prancer vixen comet
cupid donner blitzen rudolph))))]
@ -80,9 +80,9 @@ This question is similar to the last. But instead of simulating one race, we hav
(flatten
(for/list ([sec (in-range 1 (add1 2503))])
(define deer-results
(map (λ(deer-func) (deer-func sec)) deer-funcs))
(map (λ (deer-func) (deer-func sec)) deer-funcs))
(define max-result (apply max deer-results))
(map (λ(deer-result deer-func)
(map (λ (deer-result deer-func)
(if (= deer-result max-result)
deer-func
empty))

@ -83,7 +83,7 @@ Plus, it's always fun to find a use for @iracket[case] and the frequently overlo
(define (q2 input-str)
(define (attrs->datums attrs)
(map (compose1 read open-input-string
(λ(attr) (format "(~a)" attr))) attrs))
(λ (attr) (format "(~a)" attr))) attrs))
(define sues (for/list ([sue-attrs (parse-sues input-str)])
(attrs->datums sue-attrs)))
(define master-datums (attrs->datums master-attrs))

@ -28,7 +28,7 @@ We do this by creating the @italic{power set} of the containers — that is, a
(if (empty? xs)
(list empty)
(append-map
(λ(s) (list (cons (car xs) s) s))
(λ (s) (list (cons (car xs) s) s))
(powerset (cdr xs)))))
]
@ -36,7 +36,7 @@ We do this by creating the @italic{power set} of the containers — that is, a
(define (q1 input-str)
(define containers
(map string->number (string-split input-str)))
(length (filter (λ(s) (= 150 (apply + s)))
(length (filter (λ (s) (= 150 (apply + s)))
(powerset containers))))]
@ -50,10 +50,10 @@ Same as above, except we find the minimum length among the winners, and then cou
(define (q2 input-str)
(define containers
(map string->number (string-split input-str)))
(let* ([winners (filter (λ(s) (= 150 (apply + s)))
(let* ([winners (filter (λ (s) (= 150 (apply + s)))
(powerset containers))]
[shortest (apply min (map length winners))])
(length (filter (λ(w) (= shortest (length w))) winners))))
(length (filter (λ (w) (= shortest (length w))) winners))))
]

@ -48,7 +48,7 @@ Each molecule transformation defines a string replacement. We'll parse our input
(define-values (molecule transformations) (parse-input-str input-str))
(length
(remove-duplicates
(append-map (λ(target replacement)
(append-map (λ (target replacement)
(transform-molecule* molecule target replacement))
(map first transformations) (map second transformations)))))]

@ -51,7 +51,7 @@ Going with the math-jock vibe, what this condition means is that the highest-num
(for/first ([house-number (in-naturals)]
#:when (let* ([elves (divisors house-number)]
[elves (filter
(λ(e) (<= house-number (* 50 e))) elves)]
(λ (e) (<= house-number (* 50 e))) elves)]
[elf-gifts
(apply + (map (curry * gifts-per-elf) elves))])
(>= elf-gifts target-gifts)))

@ -43,7 +43,7 @@ Notice also that we're encasing the lines of the VM program in @iracket[thunk*].
(syntax-case stx ()
[(_)
(let* ([input-strings (file->lines "day23-input.txt")]
[inst-strings (map (λ(str) (format "(thunk* (inst ~a))" (string-replace str "," ""))) input-strings)]
[inst-strings (map (λ (str) (format "(thunk* (inst ~a))" (string-replace str "," ""))) input-strings)]
[inst-datums (map (compose1 read open-input-string) inst-strings)])
(datum->syntax stx `(define instructions (list ,@inst-datums))))]))
@ -55,9 +55,9 @@ Notice also that we're encasing the lines of the VM program in @iracket[thunk*].
(hash-update! registers reg thunk)
default-offset))
(define-reg-updater tpl (λ(val) (* 3 val)))
(define-reg-updater inc (λ(val) (add1 val)))
(define-reg-updater hlf (λ(val) (/ val 2)))
(define-reg-updater tpl (λ (val) (* 3 val)))
(define-reg-updater inc (λ (val) (add1 val)))
(define-reg-updater hlf (λ (val) (/ val 2)))
(define (jmpf reg num pred)
(if (pred (hash-ref registers reg)) num 1))

@ -39,7 +39,7 @@ After that, we just need to write a function that will test whether a given grou
(append*
(for/list ([x (in-list packages)])
(define later-packages (cdr (member x packages)))
(append-map (λ(ss) (define new-group (cons x ss))
(append-map (λ (ss) (define new-group (cons x ss))
(if (= goal-weight (weight new-group))
(list new-group)
empty))
@ -50,7 +50,7 @@ After that, we just need to write a function that will test whether a given grou
(define (quantum-entanglement group) (apply * group))
(define (remove-group group packages)
(filter (λ(p) (not (member p group))) packages))
(filter (λ (p) (not (member p group))) packages))
(define (has-solution? group packages)
(define target-weight (weight group))