Advent of Code 2020 6-10

(define customs (~> (fetch-aoc-input (find-session) 2020 6) (string-split "

")))

;; part 1
(~>> customs
     (map (λ (sheet) (~> sheet
                         (string-replace "
" "")
                         string->list
                         remove-duplicates
                         length)))
     (apply +))

;; part 2
(~>> customs
     (map (λ (sheet) (~>> sheet
                          string-split
                          (map (λ (subls) (list->set (string->list subls))))
                          (apply set-intersect)
                          set-count)))
     (apply +))

(define rules (~> (fetch-aoc-input (find-session) 2020 7) (string-split "
")))

(define (parse-bag-rule rule)
  (define parts (regexp-match #px"^([^ ]+ [^ ]+) bags contain (.*)\.$" rule))
  (let* ([color (second parts)]
         [children (third parts)]
         [child-matches (regexp-match* #px"(\d+) ([^,]+ [^,]+) bag" children)])
    (list color
          (for/list ([child child-matches])
            (let ([child-parts (regexp-match #px"^(\d+) ([^,]+ [^,]+) bag" child)])
              (list (string->number (second child-parts)) (third child-parts)))))))

(define bag-hash
  (for/hash ([rule rules])
    (match-let ([(list color children) (parse-bag-rule rule)])
      (values color children))))

;; bag-hash looks like:
'#hash(("bright white" . ((1 "shiny gold")))
       ("dark olive" . ((3 "faded blue") (4 "dotted black")))
       ("dark orange" . ((3 "bright white") (4 "muted yellow")))
       ("dotted black" . ())
       ("faded blue" . ())
       ("light red" . ((1 "bright white") (2 "muted yellow")))
       ("muted yellow" . ((2 "shiny gold") (9 "faded blue")))
       ("shiny gold" . ((1 "dark olive") (2 "vibrant plum")))
       ("vibrant plum" . ((5 "faded blue") (6 "dotted black"))))

;; contained hash flips the direction
;; values are all the bags that contain the key
(define contained-hash
  (for/hash ([hk (hash-keys bag-hash)])
    (values hk (for/fold ([contained '()]
                          #:result (flatten contained))
                         ([(in-k hv) (in-hash bag-hash)]
                          #:when (and ((compose not false?) (member hk (flatten hv)))
                                      ((compose not empty?) hv)))
                 (cons in-k contained)))))

;; contained-hash looks like
'#hash(("bright white" . ("light red" "dark orange"))
       ("dark olive" . ("shiny gold"))
       ("dark orange" . ())
       ("dotted black" . ("vibrant plum" "dark olive"))
       ("faded blue" . ("vibrant plum" "muted yellow" "dark olive"))
       ("light red" . ())
       ("muted yellow" . ("light red" "dark orange"))
       ("shiny gold" . ("muted yellow" "bright white"))
       ("vibrant plum" . ("shiny gold")))

;; part 1
;; now we need to recursively find all the bags "above" shiny gold
(~>
 (let rc ([bag (hash-ref contained-hash "vibrant plum")])
   (match bag
     ['() '()]
     [_
      (append
       (map (compose rc (curry hash-ref contained-hash)) bag) bag)]))
 flatten
 remove-duplicates
 length)

;; part 2
(let rc ([sub-bags (hash-ref bag-hash "shiny gold")])
  (match sub-bags
    ['() 0]
    [_
     (apply + (map (λ (bag)
                     (match-let ([(list bcount color) bag])
                       (+ bcount (* bcount (rc (hash-ref bag-hash color))))))
                   sub-bags))]))

(define (parse-op op)
  (match-let ([(list operation num) (string-split op)])
    (list operation (string->number num))))

(define boot (~> (fetch-aoc-input (find-session) 2020 8)
                 (string-split "
")
                 (map parse-op _)))

;; part 1
(let loop ([seen '()] [acc 0] [idx 0])
  (match-let ([(list op amt) (list-ref boot idx)])
    (if (member idx seen)
        acc
        (match op
          ["acc" (loop (cons idx seen) (+ amt acc) (add1 idx))]
          ["jmp" (loop (cons idx seen) acc (+ amt idx))]
          [_ (loop (cons idx seen) acc (add1 idx))]))))

;; part 2

;; update part 1 to return #f if a cycle is found, acc if not
(define (try-boot-set boot)
  (let loop ([seen '()] [acc 0] [idx 0])
    (match idx
      [(== (length boot)) acc]
      [_
       (match-let ([(list op amt) (list-ref boot idx)])
         (if (member idx seen)
             #f
             (match op
               ["acc" (loop (cons idx seen) (+ amt acc) (add1 idx))]
               ["jmp" (loop (cons idx seen) acc (+ amt idx))]
               [_ (loop (cons idx seen) acc (add1 idx))])))])))


;; iterate through
;; if we find a nop or a jmp, swap and check if it has a cycle
(let ([swap-instr (λ (op idx)
                    (let ([new-op (match op ["nop" "jmp"] ["jmp" "nop"])])
                      (list-update boot idx (λ (p) (list new-op (second p))))))])
  (for/or ([instr (in-list boot)]
           [idx (in-naturals)]
           #:do [(define op (first instr))]
           #:when (member op (list "nop" "jmp")))
    (try-boot-set (swap-instr op idx))))

(define XMAS (~> (fetch-aoc-input (find-session) 2020 9)
                 (string-split "
")
                 (map string->number _)))

(define preamble-length 25)

(define (sliding-window ls n [into into-list])
  (transduce ls (windowing n) #:into into))

(define (vector-values-between idx1 idx2 vec)
  (for/list ([idx (in-range idx1 idx2)])
    (vector-ref vec idx)))

(define (two-sum nums target)
  (define (iter nums)
    (if (or (null? nums) (null? (rest nums)))
        #f
        (let ([fs (first nums)]
              [ls (last nums)])
          (match (- (+ fs ls) target)
            [0 (list fs ls)]
            [(? negative?) (iter (rest nums))]
            [(? positive?) (iter (drop-right nums 1))]))))
  (define get-nums (iter (sort nums <)))
  (if get-nums
      (map (λ (v) (index-of nums v)) get-nums)
      #f))

;; part 1: 1492208709
(define p1-answer
  (for/first ([window (sliding-window XMAS (add1 preamble-length))]
              #:do [(match-define-values (preamble (list target)) (split-at-right window 1))]
              #:when (false? (two-sum preamble target)))
    target))

;; part 2 238243506
(let ([xmas (list->vector XMAS)]
      [goal p1-answer])
  (let loop ([left 0] [right 1])
    (let* ([vals-between (vector-values-between left right xmas)]
           [sum (apply + vals-between)])
      (cond [(equal? sum goal) ((λ (ls)
                                  (apply + (list (apply min ls) (apply max ls))))
                                vals-between)]
            [(< sum goal) (loop left (add1 right))]
            [else (loop (add1 left) right)]))))

(require racket threading advent-of-code
         (only-in srfi/1 map))

(define jolts (~> (fetch-aoc-input (find-session) 2020 10)
                  (string-split "
")
                  (map string->number _)
                  ((λ (v)
                     (cons (+ 3 (apply max v))
                           (append (sort v >) '(0)))) _)))

(define (vector-values-between idx1 idx2 vec)
  (for/list ([idx (in-range idx1 idx2)])
    (vector-ref vec idx)))

;; part 1
(let* ([counts (map - jolts (rest jolts))])
  (apply * (list (count (curry equal? 3) counts)
                 (count (curry equal? 1) counts))))

;; part 2
(let* ([jolts (list->vector (map cons (range 0 (length jolts)) (reverse jolts)))]
       [memo (make-hash)])
  (define (rec idx)
    (cond
      [(hash-has-key? memo idx) (hash-ref memo idx)]
      [(= idx (vector-length jolts)) 1]
      [else
       (let* ([curr-val (cdr (vector-ref jolts idx))]
              [possibilities
               (filter
                (λ (v) (<= (- (cdr v) curr-val) 3))
                (vector-values-between (add1 idx) (min (vector-length jolts) (+ idx 4)) jolts))]
              [result
               (match possibilities
                 ['() 1]
                 [_ (apply + (map (compose rec car) possibilities))])])
         (hash-set! memo idx result)
         result)]))
  (rec 0))