Abstracted message-printing from days 11 and 8; Added fancy symbols for currying, uncurrying, and composition.

This commit is contained in:
Jonathan Chan 2019-12-11 13:54:01 -08:00
parent ce29e2e206
commit 154b2f33ed
5 changed files with 52 additions and 32 deletions

28
lib.rkt
View File

@ -9,6 +9,8 @@
(provide problem-input
show-solution
show-msg
$
uncurry
sum
neq?
@ -25,6 +27,17 @@
vector-ref*
vector-set!*)
;; Function helpers ;;
(define compose)
(define curry)
;; uncurry : (a1 -> ... -> an -> b) -> ((listof a) -> b)
(define uncurry
(curry apply))
(define $ uncurry)
;; IO helpers ;;
;; problem-input : number? -> (listof string?)
@ -39,12 +52,15 @@
(define (show-solution part1 part2)
(printf "Part 1: ~a\nPart 2: ~a\n" part1 part2))
;; Function helpers ;;
;; uncurry : (a1 -> ... -> an -> b) -> ((listof a) -> b)
(define uncurry
(curry apply))
;; show-msg : (hashof (a => char)) -> (listof (listof a)) -> void
;; Given a grid of values, show the grid line by line,
;; with values replaced by characters in the given hash.
(define (show-msg char-hash msg)
(for-each
displayln
(map ( list->string
( map ( hash-ref char-hash)))
msg)))
;; Number helpers ;;

View File

@ -20,17 +20,17 @@
(apply max (append (map amplify phases)))))
(define (amplify-loop phase)
(let* ([amps (map (curry resume-with-input (exec input)) phase)]
(let* ([amps (map ( resume-with-input (exec input)) phase)]
[Q (list->queue amps)])
(let loop ([signal 0])
(define amp (dequeue! Q))
(type-case state amp
[halt (_) signal]
[in (resume)
(define-values (signal st)
(define-values (signal* st)
(resume-with-output (resume signal)))
(enqueue! Q st)
(loop signal)]
(loop signal*)]
[else (error "amplify-loop: Unexpected program state.")]))))
(define part2

View File

@ -8,23 +8,24 @@
(define width 25)
(define height 6)
(define pixel-hash
(make-hash '((#\0 . #\ ) (#\1 . #\█))))
(define layers
(let* ([area (* width height)]
[chars (string->list input)])
(chunks-of chars area)))
(define part1
(let* ([zeroes (map (curry count (curry eq? #\0)) layers)]
(let* ([zeroes (map ( count ( eq? #\0)) layers)]
[min-index (index-of zeroes (apply min zeroes))]
[min-layer (list-ref layers min-index)]
[ones (count (curry eq? #\1) min-layer)]
[twos (count (curry eq? #\2) min-layer)])
[ones (count ( eq? #\1) min-layer)]
[twos (count ( eq? #\2) min-layer)])
(* ones twos)))
(define part2
(let* ([image (map (curry findf (curry neq? #\2)) (transpose layers))]
[image* (map (λ (pixel) (if (eq? pixel #\1) #\█ #\ )) image)]
[msg (map list->string (chunks-of image* width))])
(for-each displayln msg)))
(let* ([image (map ( findf ( neq? #\2)) (transpose layers))])
(show-msg pixel-hash (chunks-of image width))))
(show-solution part1 #f)

View File

@ -20,7 +20,7 @@
(define (offsets x y)
(let ([is (range (negate x) (- width x))]
[js (range (negate y) (- height y))])
(filter (uncurry coprime?) (cartesian-product is js))))
(filter ($ coprime?) (cartesian-product is js))))
(define (asteroid? x y)
(define row (list-ref input y))
@ -36,13 +36,13 @@
[else (loop (add1 m))]))))
(define (asteroids x y)
(filter-map (uncurry (curry asteroid-offset x y)) (offsets x y)))
(filter-map ($ ( asteroid-offset x y)) (offsets x y)))
(define-values (part1 location in-view)
(let* ([cols (range width)]
[rows (range height)]
[locations (filter (uncurry asteroid?) (cartesian-product cols rows))]
[in-views (map (uncurry asteroids) locations)]
[locations (filter ($ asteroid?) (cartesian-product cols rows))]
[in-views (map ($ asteroids) locations)]
[counts (map length in-views)]
[maximum (apply max counts)]
[index (index-of counts maximum)])

View File

@ -6,6 +6,13 @@
(define input
(string->program (car (problem-input 11))))
;; 0 is a "black" panel and 1 is a "white" panel
;; but the spaceship is entirely black
;; so the identifier colour is in "white"
;; which we show as black blocks against white
(define panel-hash
(make-hash '((0 . #\ ) (1 . #\█))))
;; The hull as a hash (x . y) -> c
;; x increases rightward
;; y increases downward
@ -17,7 +24,7 @@
(define (make-grid xrange yrange)
(build-vector
(add1 yrange)
(λ (_) (make-vector (add1 xrange) #\ ))))
(λ (_) (make-vector (add1 xrange)))))
;; Turn CCW if δ = 0, CW if δ = 1
(define (update-dir dir δ)
@ -67,16 +74,12 @@
[ymin (apply min ys)] [ymax (apply max ys)]
[xrange (- xmax xmin)] [yrange (- ymax ymin)]
[grid (make-grid xrange yrange)])
(for-each
(λ (kv)
(let* ([x (- (caar kv) xmin)]
[y (- (cdar kv) ymin)]
[c (cdr kv)]
[row (vector-ref grid y)])
(cond [(= c 1) (vector-set! row x #\█)])))
(hash->list hull))
(for-each
(λ (row) (displayln (list->string (vector->list row))))
(vector->list grid))))
(hash-for-each
hull
(λ (xy c)
(let* ([x (- (car xy) xmin)]
[y (- (cdr xy) ymin)])
(vector-set! (vector-ref grid y) x c))))
(show-msg panel-hash (map vector->list (vector->list grid)))))
(show-solution (part1) (part2))