Advent of Code 2020 16-20

Parsing tickets via $x \in \bigcap_j \mathcal{R}_j$ and tiling monsters so $f(x)=R x + t$ lines up.

10/10/2024

Preamble

I've started doing some of the older (year 2020) advent of code problems for fun / preparation for this years AoC. Here are my solutions to days 16-20.

You can find:

1-5 here
6-10 here
11-15 here

Day 16

(require racket threading advent-of-code
         rebellion/base/range)

(define-struct field (name ranges))

(define (parse-ticket ticket)
  (map string->number (string-split ticket ",")))

(define (parse-field field-str)
  (define split-result (string-split field-str ": "))
  (let ([name (first split-result)]
        [ranges-part (second split-result)])
    (define range-strings (string-split ranges-part " or "))
    (define ranges (map parse-range range-strings))
    (field name ranges)))

(define (parse-range range-str)
  "Parses a range string like '1-3' into a Range object."
  (define split-result (map string->number (string-split range-str "-")))
  (define start (first split-result))
  (define end (second split-result))
  (closed-range start end))

(define ticket-info
  (~>> (fetch-aoc-input (find-session) 2020 16)
       (string-split _ "

")
       (map (λ~> (string-split "
")))
       ((λ (tri)
          (let ([parse-tickets (curry map parse-ticket)]
                [parse-fields (curry map parse-field)])
            (list (parse-fields (first tri))
                  (parse-tickets (drop (second tri) 1))
                  (parse-tickets (drop (third tri) 1))))))))

;; part 1
(let* ([ranges (first ticket-info)]
       [tickets (third ticket-info)]
       [field-ranges (flatten (map field-ranges (first ticket-info)))]
       [valid-number? (λ (num)
                        (ormap identity (map (λ (range) (range-contains? range num)) field-ranges)))])
  (for*/sum ([ticket tickets]
             [ticket-val ticket]
             #:when (false? (valid-number? ticket-val)))
    ticket-val))

;; part 2
;; find invalid numbers
(define invalid-numbers
  (let* ([ranges (first ticket-info)]
         [tickets (third ticket-info)]
         [field-ranges (flatten (map field-ranges (first ticket-info)))]
         [valid-number? (λ (num)
                          (ormap identity (map (λ (range) (range-contains? range num)) field-ranges)))])
    (for*/list ([ticket tickets]
                [ticket-val ticket]
                #:when (false? (valid-number? ticket-val)))
      ticket-val)))

;; if a ticket contains any invalid value, drop it entirely
(define (list-contains-any? base-list membership-list)
  (ormap (λ (x) (not (not (member x membership-list)))) base-list))

(define (ranges-contains? ranges v) (ormap (λ~> (range-contains? v)) ranges))

(define valid-tickets
  (filter
   (compose not (curryr list-contains-any? invalid-numbers))
   (third ticket-info)))

(define (range-union-contains? ranges v)
  (ormap (λ~> (range-contains? v)) ranges))

(apply set-intersect
       (let* ([fields (first ticket-info)])
         (for/list ([ticket valid-tickets])
           (for/fold ([solns (mutable-set)])
                     ([perm (in-permutations fields)]
                      #:when (andmap (λ (ru t) (range-union-contains? ru t)) (map field-ranges perm) ticket)
                      #:break (equal? (set-count solns) 1))
             (let ([res (map field-name perm)])
               (if (set-empty? solns)
                   res
                   (set-intersect res solns)))))))

Notes

This solution uses the wonderful rebellion package, which has a nice range data structure. Note the use of closed-range.

Other than that, I started using λ~> which essentially translates to λ (whatever) (~> whatever fns ...). Pretty handy for mapping!

Day 17

(define cubes
  (~>>
   (fetch-aoc-input (find-session) 2020 17)
   (string-split _ "
")
   (map string->list)))

(define DIMENSION 5)

(define (make-neighbor-offsets dim)
  (~>> (make-list dim '(-1 0 1))
       (apply cartesian-product)
       (filter (λ~> (equal? (make-list dim 0)) not))))

(define neighbor-offsets (make-neighbor-offsets DIMENSION))

(define points
  (for*/hash ([y (length cubes)]
              [x (in-range (length (first cubes)))]
              #:do [(define val (list-ref (list-ref cubes y) x))]
              #:when (char=? val ##))
    (values (append (list x y) (make-list (- DIMENSION 2) 0)) val)))

(define (count-active-neighbors active-cubes)
  (let ([neighbor-counts (make-hash)])
    (for* ([cube (in-hash-keys active-cubes)]
           [offset neighbor-offsets])
      (let ([neighbor (map + cube offset)])
        (hash-update! neighbor-counts neighbor add1 0)))
    neighbor-counts))

(define (change-state pt-state actives-len)
  (match pt-state
    [## (match actives-len [(or 2 3) ##] [_ #.])]
    [#. (match actives-len [3 ##] [_ #.])]))

(define (next-step active-cubes)
  (let ([neighbors (count-active-neighbors active-cubes)])
    (for/hash ([(pt n-count) (in-hash neighbors)]
               #:do [(define curr-state (if (hash-has-key? active-cubes pt) ## #.))
                     (define next-state (change-state curr-state n-count))]
               #:when (char=? next-state ##))
      (values pt ##))))

(define (simulate-cycles active-cubes cycles)
  (define current-active active-cubes)
  (for ([i (in-range cycles)])
    (set! current-active (next-step current-active)))
  current-active)

;; part 1
(hash-count (simulate-cycles points 6))

#|

part 2 is the same as above, except that we extend the dimensions to
include the 4th dimension, w. All you need to do is set DIMENSION to 4
and rerun the above.

The dim=5 case takes about an order of magnitude longer

|#

Notes

This one handled both parts pretty nicely! Just change the DIMENSION global from 3->4 and you are good to handle part 2.

Overall this was a neat problem. Likely one of my favorites so far.

Day 18

(define hw (~> (fetch-aoc-input (find-session) 2020 18)
               (string-split "
")))

(define (try func [else-func identity])
  (λ (x)
    (let ([result (func x)])
      (if result result (else-func x)))))

(define (clean-simple-expr expr)
  (map (lambda (token)
         (if (regexp-match? #px"^[0-9]+$" token)
             (string->number token)
             (string->symbol token)))
       (regexp-match* #px"\d+|[+*]" expr)))

(define (eval-simple-expr expr)
  (let ([tokens (clean-simple-expr expr)])
    (let loop ([tokens tokens] [current-result 0] [current-op '+])
      (cond
        [(null? tokens) current-result]
        [(number? (car tokens))
         (let ([num (car tokens)])
           (loop (cdr tokens)
                 (case current-op
                   ['+ (+ current-result num)]
                   ['* (* current-result num)]
                   [else (error "Unsupported operator" current-op)])
                 current-op))]
        [(symbol? (car tokens))
         (let ([op (car tokens)])
           (if (or (eq? op '+) (eq? op '*) )
               (loop (cdr tokens) current-result op)
               (error "Unsupported operator" op)))]
        [else
         (error "Invalid token" (car tokens))]))))

(define (find-expressions-without-nested-parens s)
  (let loop ([i 0]
             [stack '()]
             [results '()])
    (if (>= i (string-length s))
        (reverse results)
        (let ([c (string-ref s i)])
          (match c
            [#( (loop (add1 i) (cons i stack) results)]
            [#)
             (if (null? stack)
                 (loop (add1 i) stack results)
                 (let* ([start (car stack)]
                        [end i]
                        [expr (substring s (add1 start) end)]
                        [has-inner (or (string-contains? expr "(")
                                       (string-contains? expr ")"))]
                        [evaluation (eval-simple-expr expr)]
                        [new-results (if (and (not has-inner) evaluation)
                                       (cons (list expr (list start end) evaluation) results)
                                       results)]
                        [new-stack (cdr stack)])
                   (loop (add1 i) new-stack new-results)))]
            [_ (loop (add1 i) stack results)])))))

(define (replace-expressions-in-string s exprs)
  (let* ([sorted-exprs (sort exprs (λ (a b) (< (first (second a)) (first (second b)))))]
         [output (open-output-string)]
         [pos 0])
    (for ([expr-info (in-list sorted-exprs)])
      (let* ([expr (first expr-info)]
             [indices (second expr-info)]
             [evaluation (third expr-info)]
             [start (first indices)]
             [end (second indices)])
        ;; Write text before the expression (including the parentheses)
        (write-string s output pos start)
        ;; Write the evaluated value
        (display evaluation output)
        ;; Update pos to after the closing parenthesis
        (set! pos (add1 end))))
    ;; Write the remaining text
    (write-string s output pos (string-length s))
    (get-output-string output)))

(define (evaluate-expression s)
  (let loop ([expr s])
    (if (or (string-contains? expr "(")
            (string-contains? expr ")"))
        ;; Expression contains parentheses, process them
        (let ([exprs (find-expressions-without-nested-parens expr)])
          (if (null? exprs)
              (error "Unbalanced or invalid expression: " expr)
              (let ([new-expr (replace-expressions-in-string expr exprs)])
                (loop new-expr))))
        ;; No parentheses left, evaluate the expression
        (eval-simple-expr expr))))

(define (process-strings strings)
  (map evaluate-expression strings))

(apply + (process-strings hw))

;; part 2
(require infix-prefix)

(define-infix->prefix-parser add-first * +)

(define (string->syntax str)
  (read (open-input-string (string-append "(" str ")"))))

(apply + (map (compose eval add-first string->syntax) hw))

Notes

part 1 approach:

clean up the expressions
write a function that evaluates simple, non-nested expressions left to right without regard for operator precedence.
write a function that finds each interior paren set and makes a structure that gives an (expression, interior expression, (opening indx, ending idx) evaluated-value)
build a new string that turns interior parens into the evaluated value
loop until the entire expression has no parens, then eval-simple value

What a pain!

For part 2, we just evaluate with a different operator precedence. This is relatively well-trodden space in lisp (since lisp languages use prefix notation, e.g. (+ 1 2)), so there is a library to convert infix to prefix. Thankfully it supports operator precedence.

Day 19

(match-define (list rules messages) (map (λ~> (string-split _ "
"))
                                         (~> (fetch-aoc-input (find-session) 2020 19)
                                             (string-split "

"))))

(define (format-rules rules)
  (let ([rule-regex #px"^([0-9]+):\s+(?:(?:\"([^\"]+)\")|([0-9\s|]+))$"])
    (for/hash ([rule rules])
      (match-let ([(list _ k letter redir) (regexp-match rule-regex rule)])
        (if letter
            (values k letter)
            (if (string-contains? redir "|")
                (values k (map string-split (string-split redir " | ")))
                (values k (list (string-split redir)))))))))

(define (combine lists-of-strings)
  (if (null? lists-of-strings)
      '("")
      (apply append
             (map (λ (str)
                    (map (λ (suffix)
                           (string-append str suffix))
                         (combine (cdr lists-of-strings))))
                  (car lists-of-strings)))))

(define parsed-rules (format-rules rules))

(define (get-messages [start "0"])
  (let rec ([rule-id start])
    (let ([hr (hash-ref parsed-rules rule-id)])
      (match hr
        [(? string?) (list hr)]
        [_ (~>> hr
                (map (λ~>> (map rec) combine))
                (apply append))]))))

(define (valid-messages [start "0"])
  (let ([possible-messages (get-messages start)])
    (~>> messages (filter (λ~> (member _ possible-messages))))))


;; part 1
(length (valid-messages))

;; part 2
(define 42-messages (get-messages "42"))
(define 31-messages (get-messages "31"))

(define (split-into lst size)
  (if (< (length lst) size)
      '()
      (cons (take lst size) (split-into (drop lst size) size))))

(define (check-str str)
  (let* ([chunks (split-into (string->list str) 8)]
         [total (length chunks)]
         [count-matches (λ (chunks matches)
                          (let loop ([chunks chunks] [cnt 0])
                            (cond [(empty? chunks) cnt]
                                  [(member (apply string (car chunks)) matches)
                                   (loop (cdr chunks) (add1 cnt))]
                                  [else cnt])))]
         [count-42 (count-matches chunks 42-messages)]
         [count-31 (count-matches (reverse chunks) 31-messages)]
         [valid
          (and
           (>= count-31 1)
           (> count-42 count-31)
           (= (+ count-42 count-31) total)
           (for/and ([chunk (in-list (take chunks (- total count-31)))])
             (member (apply string chunk) 42-messages)))])
    valid))

(length (filter identity (map check-str messages)))

Notes

This would have been very hard indeed if the recursive rules provided for 8 and 11 weren't so straight-forward.

Day 20

(define (parse-tile tile)
  (~> tile
      ((λ (tile)
         (list (string->number (substring (first tile) 5 9))
               (map string->list (rest tile)))))))

(define tiles
  (~> (fetch-aoc-input (find-session) 2020 20)
      (string-split "

")
      (map (λ~> (string-split _ "
") parse-tile) _)))

(define (get-edges data)
  (let* ([number (car data)]
         [matrix (cadr data)]
         [top (car matrix)]
         [bottom (car (reverse matrix))]
         [left (map car matrix)]
         [right (map last matrix)]
         [edges (list top right bottom left)]
         [edge-variants (apply append (map (λ (edge) (list edge (reverse edge))) edges))])
    (list number edge-variants)))

(define edge-counts
  (let ([hsh (make-hash)])
    (for* ([tile tiles]
           [edge (cadr (get-edges tile))])
      (hash-update! hsh edge add1 0))
    hsh))

(for/product ([tile tiles]
              #:do [(match-define (list tnum _) tile)
                    (define edges (cadr (get-edges tile)))
                    (define unique-edges (filter (λ~> (hash-ref edge-counts _) (equal? 1 _)) edges))]
              #:when (= 4 (length unique-edges)))
  tnum)

Notes

This is just part 1! For part 2, I am having a difficult time. It seems this is one of the hardest problems in the AoC repertoire (according to Unofficial Leaderboard Times). I've found someone else's code that works here. It seems they used backtracking, which is something I've done a few leetcode problems on but haven't used seriously. Something to add to the to be practiced folder.