Advent of Code 2020 21-25

Resolving allergens with

I = \bigcap_k \mathcal{I}_k

and CRT shuttles using

t \equiv a_i \pmod{n_i}

advent of coderacketalgorithms

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 21-25.

You can find:

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

Day 21

#lang racket
(require racket threading advent-of-code)

(define foods (fetch-aoc-input (find-session) 2020 21))

(define parsed-food
  (~>> foods
       (string-split _ "
")
       (map (λ (line)
              (match-let* ([(list ingredients allergens) (string-split line " (contains ")]
                           [ingredients (string-split ingredients)]
                           [allergens (~> allergens
                                          (string-replace ")" "")
                                          (string-split ", ")
                                          (map string-trim _))])
                (list ingredients allergens))))))

;; part 1
(define shared-allergens
  (let ([hsh (make-hash)])
    (for* ([food parsed-food]
           #:do [(match-define (list food-ls allergens) food)]
           [allergen allergens])
      (hash-update! hsh allergen (curry set-intersect (list->set food-ls)) (list->set food-ls)))
    hsh))

(let* ([allergenic (apply set-union (hash-values shared-allergens))]
       [all-food (apply set-union (map (λ~> first list->set) parsed-food))]
       [safe-food (set-subtract all-food allergenic)]
       [foods-ls (flatten (map first parsed-food))])
  (for/sum ([safe safe-food])
    (count (curry equal? safe) foods-ls)))

;; part 2
(let ([pairs '()])
  (let loop ([hsh (hash-copy shared-allergens)])
    (for ([(allergen ingredients) (in-hash hsh)]
          #:when (equal? 1 (set-count ingredients)))
      (begin
        (set! pairs (cons (cons allergen (set-first ingredients)) pairs))
        (loop (hash-map/copy hsh (λ (k v) (values k (remove (set-first ingredients) (set->list v)))))))))
  (string-join (map cdr (sort (remove-duplicates pairs) #:key car string<?)) ","))

Notes

pretty elegant for this far along

Day 22

(require racket threading advent-of-code)

(define deck
  (~> (fetch-aoc-input (find-session) 2020 22)
      (string-split "

")
      (map (λ~>
            (string-split ":")
            ((λ (pair)
               (list (first pair)
                     (map string->number (string-split (second pair) "
")))))) _)))

(define (play-game deck)
  (match-let ([(list (list p1n p1-hand) (list p2n p2-hand)) deck])
    (let loop ([p1 p1-hand] [p2 p2-hand])
      (cond [(empty? p1) (list p2n p2)]
            [(empty? p2) (list p1n p1)]
            [(> (first p1) (first p2))
             (loop (append (rest p1) (list (first p1) (first p2))) (rest p2))]
            [else (loop (rest p1)
                        (append (rest p2) (list (first p2) (first p1))))]))))

(define (deck-key p1 p2)
  (string-append
   (string-join (map number->string p1) ",") "|" (string-join (map number->string p2) ",")))

(define (play-recursive-game deck)
  (match-let ([(list (list p1n p1) (list p2n p2)) deck]
              [memo (make-hash)])
    (let loop ([p1 p1] [p2 p2])
      (let ([key (deck-key p1 p2)])
        (if (hash-has-key? memo key)
            ;; Previous state encountered, player 1 wins
            (list "Player 1" p1)
            (begin
              (hash-set! memo key #t)
              (cond
                [(empty? p1) (list "Player 2" p2)]
                [(empty? p2) (list "Player 1" p1)]
                [else
                 (match-let* ([(list c1 rest-p1 ...) p1]
                              [(list c2 rest-p2 ...) p2]
                              [winner
                               (cond [(and (>= (length rest-p1) c1)
                                           (>= (length rest-p2) c2))
                                      ;; Recurse into a sub-game
                                      (first (play-recursive-game
                                              (list (list "Player 1" (take rest-p1 c1))
                                                    (list "Player 2" (take rest-p2 c2)))))]
                                     [(> c1 c2) "Player 1"]
                                     [else "Player 2"])])
                   (if (string=? winner "Player 1")
                       (loop (append rest-p1 (list c1 c2)) rest-p2)
                       (loop rest-p1 (append rest-p2 (list c2 c1)))))])))))))

(define (get-score deck game)
  (match-let ([(list _ cards) (game deck)])
    (for/sum ([card cards]
              [idx (in-inclusive-range (length cards) 0 -1)])
      (* card idx))))

;; part 1
(get-score deck play-game)

;; part 2
(get-score deck play-recursive-game)

Notes

match-let* came in pretty nice here. I quite like the extra utilities for any number of the previous pattern like:

(match-let* ([(list c1 rest-p1 ...) p1] [(list c2 rest-p2 ...) p2]

Day 23

(require racket threading advent-of-code)

(define cups
  (~>> "389125467"
       (string-split _ "")
       (filter (compose not (curry equal? "")))
       (map string->number)))


;; let's try simulating with in-cycle
(define (stream-take-until st v)
  (if (equal? (stream-first st) v)
      st
      (stream-take-until (stream-rest st) v)))

(define (list-reorder-first ls v)
  (let ([val-idx (index-of ls v)])
    (append (drop ls val-idx)
            (take ls val-idx))))

(~> (for/fold ([curr-idx 0] [cups cups] #:result cups)
              ([idx (in-range 0 10)])
  (let* ([current-cup-idx curr-idx]
         [current-cup (list-ref cups current-cup-idx)]
         [pick-up (take (drop cups (add1 current-cup-idx)) 3)]
         [unordered-subset-circle (filter (λ (v) (not (member v pick-up))) cups)]
         [ordered-subset-circle (sort unordered-subset-circle <)]
         [destination (let ([curr-cup-sorted-idx (index-of ordered-subset-circle current-cup)])
                        (if (zero? curr-cup-sorted-idx)
                            (last ordered-subset-circle)
                            (list-ref ordered-subset-circle (sub1 curr-cup-sorted-idx))))]
         [new-order (list-reorder-first (list-insert unordered-subset-circle
                                                     (add1 (index-of unordered-subset-circle destination)) pick-up)
                                        current-cup)])
    (values 1 new-order)))
    (list-reorder-first 1)
    (drop 1))

Notes

Only part 1 here! Part 2 is forth-coming. I tried to be fancy and use infinite cyclic streams with something like this:

(define (list->stream-cycle ls)
  ((λ~> in-list in-cycle sequence->stream) ls))

still lots of details to work out. I'm guessing most solutions are some kind of index juggling

Day 24

(require racket racket/hash threading advent-of-code)

(define tile-map
  (~> (fetch-aoc-input (find-session) 2020 24)
   (string-split "
")))

;; parse string into individual directoins
(define (parse-directions input)
  (regexp-match* #rx"(se|sw|ne|nw|e|w)" input))


;; part 1
(define axial-coordinate-diff-hash
  ;; (dq dr) where q is northwest and r is east
  ;; see https://www.redblobgames.com/grids/hexagons/
  (make-hash '(("ne" (1 -1))
               ("se" (0 1))
               ("sw" (-1 1))
               ("nw" (0 -1))
               ("w" (-1 0))
               ("e" (1 0)))))

(define (get-final-location str)
  (let ([parsed-string (parse-directions str)])
    (foldl (λ (pair orig) (list (+ (first pair) (first orig))
                                (+ (second pair) (second orig))))
           (list 0 0)
           (map (compose first (curry hash-ref axial-coordinate-diff-hash)) parsed-string))))

(define (val->color val)
  (if (odd? val) 'black 'white))

(define location-visits
  (let ([hsh (make-hash)])
    (for ([p (map get-final-location tile-map)])
      (hash-update! hsh p add1 0))
    ;; set odds to black, evens to white
    (for ([(loc val) (in-hash hsh)])
      (hash-set! hsh loc (val->color val)))
    hsh))

(hash-count (hash-filter-values location-visits (curry equal? 'black)))

;; part 2
(define neighbor-offsets '((1 -1) (1 0) (0 1) (-1 1) (-1 0) (0 -1)))

(define (get-neighbors loc)
  (map (λ (offset)
         (map + loc offset))
       neighbor-offsets))

(define (rule-check curr-color black-count)
  (match curr-color
    ['black (if (or (equal? black-count 0) (> black-count 2))
                'white
                'black)]
    ['white (if (equal? black-count 2)
                'black
                'white)]))

(define (add-peripherals black-tiles)
  (let ([tiles-set (make-hash)])
    (for ([tile (in-hash-keys black-tiles)])
      (begin
        (hash-set! tiles-set tile 'black)
        (for ([neighbor (get-neighbors tile)])
          (unless (hash-has-key? tiles-set neighbor)
            (hash-set! tiles-set neighbor 'white)))))
    tiles-set))

(define is-black? (curry equal? 'black))

(define (next-step black-tiles)
  (let ([loc-with-periph (add-peripherals black-tiles)]
        [new-hsh (make-hash)])
    (for/list ([(loc color) (in-hash loc-with-periph)])
      (let* ([adjacents (get-neighbors loc)]
             [black-adj (hash-filter-values
                         (hash-filter-keys loc-with-periph (λ (k) (member k adjacents)))
                         (curry equal? 'black))]
             [black-count (hash-count black-adj)])
        (let ([new-color (rule-check color black-count)])
          (hash-set! new-hsh loc new-color))))
    new-hsh))

(let ([lobby-layout (hash-filter-values location-visits is-black?)])
  (for ([idx (in-inclusive-range 0 100)])
    (when (equal? (remainder idx 10) 0)
      (displayln (format "idx: ~a num-blacks: ~a" idx (hash-count (hash-filter-values lobby-layout is-black?)))))
    (set! lobby-layout
          (hash-filter-values (next-step lobby-layout) is-black?)))
  (hash-count (hash-filter-values lobby-layout is-black?)))

Notes

Pretty fun, not too bad overall. My initial approach was to identify a hexagon with (angle, distance). This probably would have worked, but the hexagonal distance metrics provided by this website were helpful.

I believe this was the 3rd game of life type question this year. It would be cool to visualize these results.

Day 25

(require racket threading advent-of-code math/number-theory)

(define card-key 8335663)
(define door-key 8614349)
(define p 20201227)
(define g 7)

;; 7^l mod 20201227 = card-key

;; baby-step giant-step algorithm for
;; calculating discrete logarithms
(define (baby-step-giant-step g h p)
  (define m (add1 (integer-sqrt (- p 1))))
  (define baby-steps (make-hash))

  ;; Baby steps
  (for ([j (in-range m)])
    (define value (modular-expt g j p))
    (hash-set! baby-steps value j))

  ;; Compute g^{-m} mod p
  (define g-inv (modular-inverse g p))
  (define g-inv-m (modular-expt g-inv m p))

  ;; Giant steps
  (define gamma h)
  (let/ec exit
    (for ([i (in-range m)])
      (define j (hash-ref baby-steps gamma #f))
      (when j
        (exit (+ (* i m) j)))
      (set! gamma (modulo (* gamma g-inv-m) p)))
    #f))

;; Find card's loop size
(define card-loop-size (baby-step-giant-step g card-key p))

;; Calculate the encryption key
(define encryption-key (modular-expt door-key card-loop-size p))

Notes

This uses the baby-step giant-step algorithm to compute the discrete logarithm of $7^l \mod {20201227} = \text{card-key}$ . I don't know enough number theory to really make sense of this. I give GPT all the credit here, I just started with a formulation of what I thought the equation was. Pretty neat that racket's math/number-theory module has all these functions available to make the code above relatively concise.