Advent of Code 2020 solutions in Racket, I guess
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

216 lines
7.3 KiB

#lang racket
(require "lib/common.rkt"
data/applicative (prefix-in f: data/functor) data/maybe data/monad
(struct posn (x y) #:transparent)
(define (board-dim board)
(cons (vector-length (vector-ref board 0))
(vector-length board)))
(define (board-set! board x y val)
(vector-set! (vector-ref board y) x val))
(define (board-ref board x y)
(vector-ref (vector-ref board y) x))
(define (board-copy board)
(vector-copy (vector-map vector-copy board)))
(define (parse prt)
(define (get-board-id str)
(match str
[(pregexp "Tile ([0-9]+):" (list _ (app string->number id))) id]
[else (error "oh no")]))
(define boards (string-split (port->string prt) "\n\n"))
(for/hash ([brd (in-list boards)])
(match-define (list (app get-board-id id) lines ...) (string-split brd "\n"))
(values id (list->vector (map (compose1 list->vector string->list) lines)))))
(define (board-edges board)
(match-define (cons m n) (board-dim board))
(list (for/vector ([row (in-vector board)]) ; LEFT
(vector-ref row 0))
(for/vector ([row (in-vector board)]) ; RIGHT
(vector-ref row (sub1 m)))
(vector-ref board 0) ; TOP
(vector-ref board (sub1 n)))) ; BOTTOM
(define (matching-edge? e1 e2)
(cond [(equal? e1 e2) 'match]
[(equal? e1 (vector-reverse e2)) 'rev-match]
[else #f]))
(define/match (edge-num->symbol n)
[(0) 'left]
[(1) 'right]
[(2) 'top]
[(3) 'bottom]
[(_) (error "bad input: edge-num->symbol")])
(define (gen-graph input)
(define ids (hash-keys input))
(define meta (make-hash))
(define edges
(for*/list ([id1 (in-list ids)]
[id2 (in-list ids)] #:unless (= id1 id2)
[i1 (in-range 4)] [i2 (in-range 4)]
[edges1 (in-value (board-edges (hash-ref input id1)))]
[edges2 (in-value (board-edges (hash-ref input id2)))]
[m (in-value (matching-edge? (list-ref edges1 i1) (list-ref edges2 i2)))]
#:when m)
(hash-set! meta
(cons id1 id2)
(list (edge-num->symbol i1) (edge-num->symbol i2) m))
(list id1 id2)))
(values (unweighted-graph/undirected edges) meta))
(define (day20a input)
(define-values (G _) (gen-graph input))
(for/product ([v (in-vertices G)])
(define neighbors (length (get-neighbors G v)))
(if (= neighbors 2) v 1)))
(define *sea-monster*
" #
# ## ## ###
# # # # # #")
; generates the number of times you need to rotate right
; hold board 1 fixed, mess with board 2
; there is a better way to do this. I am not doing it /deliberately/
(define (rotate-relative rot1 rot2)
(match rot1
['top (match rot2
['top 2]
['bottom 0]
['left 3]
['right 1])]
['bottom (match rot2
['top 0]
['bottom 2]
['left 1]
['right 3])]
['left (match rot2
['top 1]
['bottom 3]
['left 2]
['right 0])]
['right (match rot2
['top 3]
['bottom 1]
['left 0]
['right 2])]))
; stupid for no reason because memes
(define (direction-loop dir n)
(cond [(zero? n) dir]
(match dir
['top 'right]
['right 'bottom]
['bottom 'left]
['left 'top])
(sub1 n))]))
(define (board-flip-x board)
; flipping on the y-axis MEANS reversing all rows
(vector-map vector-reverse board))
(define (board-flip-y board)
; flipping on the x-axis MEANS reversing the vector
(vector-reverse board))
(define (board-rotate board)
(match-define (cons m _) (board-dim board))
(for/vector ([idx (in-range 0 m)])
(for/vector ([row (in-vector board)])
(vector-ref row idx))))
(define current-board-states (make-parameter (hash)))
(define (board-rotate-n! board n id upd)
(define cur (hash-ref upd id (cons #f #f)))
(hash-set! upd id (cons n (cdr cur)))
(for/fold ([brd board])
([i (in-range 0 n)])
(board-rotate brd)))
; generates an applicative functor that moves the board at id2 relative to id1
; also updates the input hash with the new transform
(define (generate-transform meta upd id1 id2)
; safely grabs data from the meta hash
; we want to be insensitive as to order, so check both possibilities
(define (get-from-meta [repeat #f])
(define val (hash-ref meta (if repeat (cons id2 id1) (cons id1 id2)) #f))
(cond [val (just val)]
[repeat nothing]
[else (get-from-meta #t)]))
; updates the metadata for the given id1 depending on former transforms
; once we place an id2, it becomes an id1. once an id1 is placed, it never becomes
; an id2 again, as it is permanently fixed in that position
(define (update-metadata rot1 mtch)
(match-define (cons rotation flip) (hash-ref upd id1 (cons #f #f)))
(define new-rotation
(if rotation (direction-loop rot1 rotation) rot1))
(define new-mtch (if flip
(match mtch ['match 'rev-match] ['rev-match 'match])
(just (list new-rotation new-mtch)))
; generates the function to flip the board if we are reversed
(define (flip-if-needed rot2 mtch)
(define cur (hash-ref upd id2 (cons #f #f)))
(cond [(and (eq? mtch 'rev-match)
(or (eq? rot2 'left) (eq? rot2 'right)))
(just board-flip-x)]
[(and (eq? mtch 'rev-match)
(or (eq? rot2 'top) (eq? rot2 'bottom)))
(just board-flip-y)]
[else (just identity)]))
; generates the function to rotate the board
(define (rotate-if-needed rot1 rot2)
(just (λ (b) (board-rotate-n! b (rotate-relative rot1 rot2) id1 upd))))
; working in a maybe context...
(do [`(,rot1/u ,rot2 ,mtch/u) <- (get-from-meta)]
[`(,rot1 ,mtch) <- (update-metadata rot1/u mtch/u)]
[flip-fn <- (flip-if-needed rot2 mtch)]
[rot-fn <- (rotate-if-needed rot1 rot2)]
(pure (compose rot-fn flip-fn))))
; computes the entirety of the board, without trimming edges
(define (assemble dim G meta)
(define meta-board (make-hash))
(define corners
(for/list ([v (in-vertices G)]
#:when (= (length (get-neighbors G v)) 2))
(define (day20b input)
(define dimension (/ (hash-count input) 2)) ; guaranteed to be square
(define-values (G meta) (gen-graph input))
(module+ main
(call-with-input-file "data/day20.txt"
(λ (prt)
(define input (parse prt))
(answer 20 1 (day20a input))
(answer 20 2 (day20b input)))))
(module+ test
(require rackunit)
(call-with-input-file "data/day20.test.txt"
(λ (prt)
(define input (parse prt))
(define-values (G meta) (gen-graph input))
; relative to 1951, 2311 should be to the right and have no other transforms
; so in effect, identity.
(check-equal? ((generate-transform meta (make-hash) 1951 2311) (just (hash-ref input 2311)))
(just (hash-ref input 2311)))
; relative to 2311, 3079 should be flipped across the x-axis
(check-equal? ((generate-transform meta (make-hash) 2311 3079) (just (hash-ref input 3079)))
(just (board-flip-x (hash-ref input 3079)))))))