Advent of Code 2022

aoc_2022.rkt

#lang racket

(module day1 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day1.txt"))

  (define debugging? (make-parameter #f))

  (define (get-calories input)
    (~>> input
         (string-split _ "\n\n")
         (map string-split)
         (map (curry map string->number))
         (map (curry apply +))))
  
  (define (part1 input)
    (apply max (get-calories input)))

  (define (part2 input)
    (apply + (take (sort (get-calories input) >) 3))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day2 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day2.txt"))

  (define debugging? (make-parameter #f))

  (define (get-strategy input rules)
    (~> input
        (regexp-replace* #rx"[ABCXYZ]" _ (λ (s) (hash-ref rules s)))
        (string-split "\n")
        (map string-split _)
        (map (curry map string->number) _)))

  (define (part1 input)
    (for/fold ([score 0])
              ([play (get-strategy input #hash(("A" . "1")
                                               ("B" . "2")
                                               ("C" . "3")
                                               ("X" . "1")
                                               ("Y" . "2")
                                               ("Z" . "3")))])
      (+ score
         (match play
           [(or '(1 2) '(2 3) '(3 1)) (+ (second play) 6)]
           [(or '(1 1) '(2 2) '(3 3)) (+ (second play) 3)]
           [(or '(1 3) '(2 1) '(3 2)) (+ (second play) 0)]))))

  (define (part2 input)
    (for/fold ([score 0])
              ([play (get-strategy input #hash(("A" . "1")
                                               ("B" . "2")
                                               ("C" . "3")
                                               ("X" . "0")
                                               ("Y" . "3")
                                               ("Z" . "6")))])
      (+ score
         (match play
           [(or '(1 3) '(2 0) '(3 6)) (+ (second play) 1)]
           [(or '(2 3) '(3 0) '(1 6)) (+ (second play) 2)]
           [(or '(3 3) '(1 0) '(2 6)) (+ (second play) 3)])))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day3 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day3.txt"))

  (define debugging? (make-parameter #f))

  (define (get-priorities xs)
    (~>> (map char->integer xs)
         (map (λ (p) (if (>= p (char->integer #\a))
                         (+ 1 (- p (char->integer #\a)))
                         (+ 27 (- p (char->integer #\A))))))))

  (define (get-compartments xs)
    (let-values ([(one two) (split-at xs (/ (length xs) 2))])
      (list one two)))

  (define (get-rucksack-compartments input)
    (~>> (string-split input "\n")
         (map string->list)
         (map get-compartments)))

  (define (get-badge xs)
    (~>> (map string->list xs)
         (map list->set)
         (apply set-intersect)
         (set-first)))

  (define (get-badges input)
    (for/fold ([badges null]
               [group null]
               #:result badges)
              ([items (string-split input "\n")])
      (if (= (length group) 2)
          (begin
            (values (cons (get-badge (cons items group)) badges) null))
          (values badges (cons items group)))))

  (define (part1 input)
    (~>> (get-rucksack-compartments input)
         (map (curry map list->set))
         (map (curry apply set-intersect))
         (map set-first)
         (get-priorities)
         (apply +)))

  (define (part2 input)
    (~>> (get-badges input)
         (get-priorities)
         (apply +))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day4 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day4.txt"))

  (define debugging? (make-parameter #f))

  (define (range-string->list rs)
    (~>> (string-split rs "-")
         (map string->number)
         (map + '(0 1))
         (apply range)))

  (define (get-pairs input)
    (~>> (string-split input "\n")
         (map (curryr string-split ","))
         (map (curry map range-string->list))))

  (define (part1 input)
    (~>> (get-pairs input)
         (map (curry map list->set))
         (count (λ (sections)
                  (or (subset? (first sections) (second sections))
                      (subset? (second sections) (first sections)))))))

  (define (part2 input)
    (~>> (get-pairs input)
         (map (curry map list->set))
         (count (λ~>> (apply set-intersect)
                      (set-empty?)
                      (not))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day5 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day5.txt"))

  (define debugging? (make-parameter #f))

  (define (get-cranes input)
    (~>> (string-split input "\n")
         (map string->list)
         (apply map list)
         (filter (λ~> (last)
                      (char-numeric?)))
         (map (curry filter char-alphabetic?))))

  (define (parse-instructions input)
    (~>> (string-split input "\n")
         (map string-split)
         (map (curry map string->number))
         (map (curry filter identity))
         (map (λ~>> (map + '(0 -1 -1))))))

  (define (get-data input)
    (let ([crane-and-instructions (~>> input
                                       (string-split _ "\n\n"))])
      (values (list->vector (get-cranes (first crane-and-instructions)))
              (parse-instructions (second crane-and-instructions)))))

  (define (part1 input)
    (let-values ([(cranes instructions) (get-data input)])
      (for ([instr instructions])
        (~> (vector-ref cranes (second instr))
            (take (first instr))
            (reverse)
            (append (vector-ref cranes (third instr)))
            (vector-set! cranes (third instr) _))

        (~> (vector-ref cranes (second instr))
            (drop (first instr))
            (vector-set! cranes (second instr) _)))
      (list->string (vector->list (vector-map first cranes)))))

  (define (part2 input)
    (let-values ([(cranes instructions) (get-data input)])
      (for ([instr instructions])
        (~> (vector-ref cranes (second instr))
            (take (first instr))
            (append (vector-ref cranes (third instr)))
            (vector-set! cranes (third instr) _))
        
        (~> (vector-ref cranes (second instr))
            (drop (first instr))
            (vector-set! cranes (second instr) _)))
      (list->string (vector->list (vector-map first cranes))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day6 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day6.txt"))

  (define debugging? (make-parameter #f))

  (define (get-unique-sequence input x)
    (let loop ([signals (string->list input)]
               [pos 0])
      (if (= x (set-count (list->set (take signals x))))
          (+ x pos)
          (loop (rest signals) (+ pos 1)))))

  (define (part1 input)
    (get-unique-sequence input 4))

  (define (part2 input)
    (get-unique-sequence input 14)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day7 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day7.txt"))

  (define debugging? (make-parameter #f))

  (define (get-fs input)
    (for/fold ([current-dir (list (make-hash))]
               #:result (last current-dir))
              ([input (string-split input "\n")])
      (let ([line (string-split input)])
        (match (first line)
          ["$" (match (second line)
                 ["cd" (match (third line)
                         [".." (rest current-dir)]
                         
                         ["/" (list (last current-dir))]

                         [else (let ([d (hash-ref! (first current-dir)
                                                   (third line)
                                                   (λ () (make-hash)))])
                                 (cons d current-dir))])]
                 
                 ["ls" current-dir])]
          
          ["dir" (hash-ref! (first current-dir)
                            (second line)
                            (λ () (make-hash)))
                 current-dir]
          
          [else (let ([size (string->number (first line))])
                  (hash-set! (first current-dir)
                             (second line)
                             size))
                current-dir]))))

  (define (get-size-of-dir dir)
    (for/fold ([sum 0])
              ([(k v) dir])
      (+ sum (if (hash? v) (get-size-of-dir v) v))))

  (define (flatten-dirs predicate dir)
    (~>> (for/list ([(k v) dir])
           (if (hash? v) (flatten-dirs predicate v) null))
         (list (if (predicate dir) (list dir) null))
         (flatten)))

  (define (part1 input)
    (~>> (get-fs input)
         (flatten-dirs (λ~> (get-size-of-dir)
                            (<= 100000)))
         (map get-size-of-dir)
         (apply +)))

  (define (part2 input)
    (let* ([fs (get-fs input)]
           [required-size (- 30000000 (- 70000000 (get-size-of-dir fs)))])
      (~>> (flatten-dirs identity fs)
           (map get-size-of-dir)
           (sort _ <)
           (filter (λ~> (> required-size)))
           (first)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day8 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day8.txt"))

  (define debugging? (make-parameter #f))

  (define (is-cell-visible-in-row? row pos)
    (let ([height (vector-ref row pos)])
      (or (for/and ([i (in-range pos)])
            (< (vector-ref row i) height))
          (for/and ([i (in-range (+ 1 pos) (vector-length row))])
            (< (vector-ref row i) height)))))

  (define (is-cell-visible-in-column? grid row col)
    (let ([height (vector-ref (vector-ref grid row) col)])
      (or (for/and ([i (in-range row)])
            (< (vector-ref (vector-ref grid i) col) height))
          (for/and ([i (in-range (+ 1 row) (vector-length grid))])
            (< (vector-ref (vector-ref grid i) col) height)))))

  (define (is-cell-visible? grid i j)
    (or (is-cell-visible-in-row? (vector-ref grid i) j)
        (is-cell-visible-in-column? grid i j)))

  (define (part1 input)
    (let* ([grid (~>> (string-split input "\n")
                      (map string->list)
                      (map (λ~>> (map string)
                                 (map string->number)
                                 (list->vector)))
                      (list->vector))]
           [grid-length (vector-length (vector-ref grid 0))]
           [grid-height (vector-length grid)])
      (for*/sum ([i (in-range grid-height)]
                 [j (in-range grid-length)])
        (if (is-cell-visible? grid i j)
            1
            0))))

  (define (part2 input)
    (let* ([grid (~>> (string-split input "\n")
                      (map string->list)
                      (map (λ~>> (map string)
                                 (map string->number))))]
           [col-grid (list->vector (map list->vector (apply map list grid)))]
           [row-grid (list->vector (map list->vector grid))]
           [grid-length (vector-length row-grid)]
           [grid-height (vector-length col-grid)])

      (define (get-distance v start end step height)
        (for/fold ([distance 0]
                   [blocked #f]
                   #:result distance)
                  ([i (in-range start end step)]
                   #:break blocked)
          (values (+ 1 distance) (>= (vector-ref v i) height))))
      
      (define (get-row-view-score v pos)
        (let ([height (vector-ref v pos)])
          (* (get-distance v (- pos 1) -1 -1 height)
             (get-distance v (+ pos 1) (vector-length v) 1 height))))

      (define (get-view-score i j)
        (* (get-row-view-score (vector-ref row-grid i) j)
           (get-row-view-score (vector-ref col-grid j) i)))

      (for*/fold ([m 0])
                 ([i (in-range grid-height)]
                  [j [in-range grid-length]])
        (max m (get-view-score i j))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day9 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day9.txt"))

  (define debugging? (make-parameter #f))

  (define (print-grid head tail)
    (for* ([j (in-range 30 -31 -1)]
           #:do [(printf "\n")]
           [i (in-range -30 31)])
      (cond
        [(v=? head (list i j)) (printf "H")]
        [(and (= 1 (length tail)) (v=? (list-ref tail 0) (list i j))) (printf "T")]
        [(member (list i j) tail) (printf "~a" (+ 1 (- (length tail) (length (member (list i j) tail)))))]
        [(v=? (list 0 0 ) (list i j)) (printf "S")]
        [else (printf ".")])))

  (define (v+ a b)
    (map + a b))

  (define (v- a b)
    (map - a b))

  (define (v=? a b)
    (and (= (first a) (first b))
         (= (second a) (second b))))

  (define (move-tail head tail)
    (let ([dist (v- head tail)])
      (match dist
        [(list 2 0) (v+ tail (list 1 0))]
        [(list 0 2) (v+ tail (list 0 1))]
        [(list -2 0) (v+ tail (list -1 0))]
        [(list 0 -2) (v+ tail (list 0 -1))]
        
        [(list 2 x) (v+ tail (list 1 (/ x (abs x))))]
        [(list x 2) (v+ tail (list (/ x (abs x)) 1))]
        [(list -2 x) (v+ tail (list -1 (/ x (abs x))))]
        [(list x -2) (v+ tail (list (/ x (abs x)) -1))]
        
        [else tail])))

  (define (move-head direction visited head tail)
    (let* ([new-head (match direction
                       ["L" (v- head '(1 0))]
                       ["R" (v+ head '(1 0))]
                       ["U" (v+ head '(0 1))]
                       ["D" (v- head '(0 1))])]
           [new-tail (for/fold ([ntail null]
                                [leader new-head]
                                #:result (reverse ntail))
                               ([follower tail])
                       (let ([new-leader (move-tail leader follower)])
                         (values (cons new-leader ntail) new-leader)))])
      (when (debugging?)
        (print-grid new-head new-tail)
        (printf "\n\n"))
      (values (cons (last new-tail) visited) new-head new-tail)))

  (define (process-moves input num-knots)
    (for*/fold ([visited (list '(0 0))]
                [head '(0 0)]
                [tail (make-list num-knots '(0 0))]
                #:result (length (remove-duplicates visited)))
               ([command-str (string-split input "\n")]
                #:do [(define command (string-split command-str))
                      (define direction (first command))
                      (define steps (string->number (second command)))]
                [i (in-range steps)])
      (let* ([command (string-split command-str)]
             [direction (first command)])
        (when (debugging?)
          (printf "~a - ~a" command i))
        (move-head direction visited head tail))))

  (define (part1 input)
    (process-moves input 1))

  (define (part2 input)
    (process-moves input 9)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day10 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day10.txt"))

  (define debugging? (make-parameter #f))

  (define (get-ops stmt-str)
    (let ([stmt (string-split stmt-str)])
      (match (first stmt)
        ["noop" (list 0)]
        ["addx" (list 0 (string->number (second stmt)))])))

  (define (part1 input)
    (define (get-signal-strength cycles x)
      (if (debugging?)
          (list x cycles)
          (* x cycles)))

    (define (update-signal-strength signal-strength cycles x)
      (if (= 0 (modulo (+ cycles 20) 40))
          (~> (get-signal-strength cycles x)
              (cons signal-strength))
          signal-strength))
    
    (for*/fold ([x 1]
                [cycles 1]
                [signal-strength null]
                #:result (if (debugging?)
                             signal-strength
                             (apply + signal-strength)))
               ([stmt-str (string-split input "\n")]
                [op (get-ops stmt-str)])
      (~>> (update-signal-strength signal-strength cycles x)
           (values (+ x op) (+ cycles 1)))))

  (define (part2 input)
    (define (update-crt crt cycles x)
      (let ([row (floor (/ cycles 40))]
            [column (modulo cycles 40)])
        (when (or (= column (- x 1))
                  (= column x)
                  (= column (+ x 1)))
          (vector-set! (vector-ref crt row) column #\#)))
      crt)

    (for*/fold ([x 1]
                [cycles 1]
                [crt (vector (make-vector 40 #\space)
                             (make-vector 40 #\space)
                             (make-vector 40 #\space)
                             (make-vector 40 #\space)
                             (make-vector 40 #\space)
                             (make-vector 40 #\space))]
                #:result (map (compose list->string vector->list) (vector->list crt)))
               ([stmt-str (string-split input "\n")]
                [op (get-ops stmt-str)])
      (values (+ x op)
              (+ cycles 1)
              (update-crt crt (- cycles 1) x)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day11 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day11.txt"))

  (define debugging? (make-parameter #f))

  (define (read-operation op-str)
    (let* ([words (string-split op-str)]
           [fn (match (fourth words)
                 ["+" +]
                 ["-" -]
                 ["*" *]
                 ["/" /])]
           [arg1 (string->number (third words))]
           [arg2 (string->number (fifth words))])
      (λ (old)
        (fn (or arg1 old) (or arg2 old)))))

  (define (read-actions true-action false-action)
    (let ([true-n (string->number (last (string-split true-action)))]
          [false-n (string->number (last (string-split false-action)))])
      (list true-n false-n)))

  (define (get-monkey-rules rules-str divisor)
    (let ([lines (string-split rules-str "\n")])
      (vector
       (~> (first lines)
           (string-split)
           (second)
           (string-replace ":" "")
           (string->number))
       (~> (string-replace (second lines) "  Starting items: " "")
           (string-replace _ " " "")
           (string-split ",")
           (map string->number _))
       (~> (third lines)
           (string-replace "  Operation: " "")
           (read-operation))
       divisor
       (~> (read-actions (fifth lines) (sixth lines))))))

  (define (get-monkey-op monkey)
    (vector-ref monkey 2))

  (define (get-monkey-test monkey)
    (vector-ref monkey 3))

  (define (get-monkey-action monkey first?)
    (let ([options (vector-ref monkey 4)])
      (if first?
          (first options)
          (second options))))

  (define (update-monkeys from to new-worry-level)
    (vector-set! to 1 (append (vector-ref to 1) (list new-worry-level)))
    (vector-set! from 1 (rest (vector-ref from 1))))

  (define (get-monkey-business monkeys num-iterations divisor mod)
    (define (modifier w) (if mod (modulo w mod) w))
    (for*/fold ([iterations (make-vector (vector-length monkeys) 0)]
                #:result (if (debugging?)
                             iterations
                             (apply * (take (sort (vector->list iterations) >) 2))))
               ([i (in-range num-iterations)]
                #:do [(when (debugging?)
                        (printf "~a\n" i)
                        (for ([m monkeys])
                          (printf "Monkey ~a: ~a\n" (vector-ref m 0) (vector-ref m 1)))
                        (printf "\n"))]
                [monkey monkeys]
                #:do [(define op (get-monkey-op monkey))
                      (define id (vector-ref monkey 0))
                      (define test (get-monkey-test monkey))]
                [item (vector-ref monkey 1)]
                #:do [(define new-worry-level (~> (floor (/ (op item) divisor))
                                                  (modifier)))
                      (define monkey-to-throw-to (~> new-worry-level
                                                     (modulo test)
                                                     (zero?)
                                                     (get-monkey-action monkey _)))])
      (update-monkeys monkey (vector-ref monkeys monkey-to-throw-to) new-worry-level)
      (vector-set! iterations id (+ 1 (vector-ref iterations id)))
      iterations))

  (define (get-divisors monkey-rules-str-list)
    (define (get-divisor rule)
      (~> (string-split rule "\n")
          (fourth)
          (string-split)
          (last)
          (string->number)))
    (map get-divisor monkey-rules-str-list))

  (define (part1 input)
    (let* ([monkey-rules-str (string-split input "\n\n")]
           [divisors (get-divisors monkey-rules-str)]
           [monkeys (list->vector (map get-monkey-rules monkey-rules-str divisors))])
      (get-monkey-business monkeys 20 3 #f)))

  (define (part2 input)
    (let* ([monkey-rules-str (string-split input "\n\n")]
           [divisors (get-divisors monkey-rules-str)]
           [m (apply lcm divisors)]
           [monkeys (list->vector (map get-monkey-rules monkey-rules-str divisors))])
      (get-monkey-business monkeys 10000 1 m))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day12 racket
  (provide part1 part2 get-input debugging?)

  (require threading
           graph
           (only-in data/gen-queue/priority mk-empty-priority)
           (only-in data/gen-queue/fifo mk-empty-fifo))

  (define (get-input)
    (file->string "day12.txt"))

  (define debugging? (make-parameter #f))

  (define (search G s)
    (define-vertex-property G shortest-path #:init +inf.0)
    (define-vertex-property G num-steps #:init 0)
    (define (weight u v) (edge-weight G u v))
    (define (comparison u v) (< (shortest-path u) (shortest-path v)))
    
    (do-bfs G s
            #:init-queue: (mk-empty-priority comparison)
            #:init: (shortest-path-set! s 0)
            #:enqueue?: (> (shortest-path $v) (+ (shortest-path $from) (weight $from $v)))
            #:on-enqueue: 
            (shortest-path-set! $v (+ (shortest-path $from) (weight $from $v)))
            (num-steps-set! $v (+ 1 (num-steps $from)))
            #:return: (num-steps->hash)))

  (define (get-graph input)
    (let* ([grid (~>> (string-split input "\n")
                      (map string->list)
                      (map (curry map char->integer))
                      (map list->vector)
                      (list->vector ))]
           [num-rows (vector-length grid)]
           [num-columns (vector-length (vector-ref grid 0))]
           [cell-number (λ (x y) (+ (* y num-columns) x))]
           [cell-value (λ (x y) (vector-ref (vector-ref grid y) x))]
           [cell-height (λ (x y)
                          (and (< -1 x num-columns)
                               (< -1 y num-rows)
                               (let ([height (cell-value x y)])
                                 (match height
                                   [83 (char->integer #\a)]
                                   [69 (char->integer #\z)]
                                   [else height]))))])
      (for*/fold ([heightmap (weighted-graph/directed null)]
                  [start-nodes null]
                  [start-node #f]
                  [end-node #f])
                 ([x (in-range num-columns)]
                  [y (in-range num-rows)]
                  #:do [(define current-node (cell-number x y))
                        (define current-elevation (cell-height x y))
                        (define current-cell-value (cell-value x y))
                        (define (add-edge nx ny)
                          (let* ([next-elevation (cell-height nx ny)]
                                 [next-node (cell-number nx ny)])
                            (when (and next-elevation (< (- next-elevation current-elevation) 2))
                              (add-directed-edge! heightmap next-node current-node 1))))])
        (map add-edge
             (list (- x 1) (+ x 1) x x)
             (list y y (- y 1) (+ y 1)))
        (match current-cell-value
          [83 (values heightmap (cons current-node start-nodes) current-node end-node)]
          [97 (values heightmap (cons current-node start-nodes) start-node end-node)]
          [69 (values heightmap start-nodes start-node current-node)]
          [else (values heightmap start-nodes start-node end-node)]))))

  (define (part1 input)
    (let-values ([(g start-nodes start-node end-node) (get-graph input)])
      (hash-ref (search g end-node) start-node)))

  (define (part2 input)
    (let-values ([(g start-nodes start-node end-node) (get-graph input)])
      (~>> (search g end-node)
           (sequence-filter (λ (k v) (and (member k start-nodes) (> v 0))))
           (sequence-map (λ (k v) v))
           (sequence-fold min +inf.0)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day13 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day13.txt"))

  (define debugging? (make-parameter #f))

  (define (read-from-string str)
    (with-input-from-string str
      read))

  (define (compare-signal lr)
    (when (debugging?) (printf "Comparing ~a ~a\n" (first lr) (second lr)))
    (match lr
      [(list '() '()) #f]

      [(list '() (list-rest r r-rest)) #t]

      [(list (list-rest l l-rest) '()) 'fail]

      [(list '() k) #t]

      [(list k '()) 'fail]

      [(list (list-rest l l-rest) (list-rest r r-rest))
       (or (compare-signal (list l r))
           (compare-signal (list l-rest r-rest)))]

      [(list (list-rest l l-rest) r)
       (compare-signal (list (first lr) (list r)))]

      [(list l (list-rest r r-rest))
       (compare-signal (list (list l) (second lr)))]

      [(list l r)
       (cond
         [(< l r) #t]
         [(= l r) #f]
         [else 'fail])]))

  (define (part1 input)
    (~>> (string-replace input "," " ")
         (string-split _ "\n\n")
         (map (curryr string-split "\n"))
         (map (curry map read-from-string))
         (map compare-signal)
         (in-indexed)
         (sequence-fold (λ (acc v i)
                          (if (equal? #t v)
                              (+ acc (+ 1 i))
                              acc))
                        0)))

  (define (part2 input)
    (let ([sorted-list (~>> (string-replace input "," " ")
                            (string-replace _ "\n\n" "\n")
                            (string-split _ "\n")
                            (map read-from-string)
                            (append '(((2)) ((6))))
                            (sort _ (λ (x y)
                                      (equal? #t (compare-signal (list x y))))))])
      (* (+ 1 (index-of sorted-list '((2))))
         (+ 1 (index-of sorted-list '((6))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module day14 racket
  (provide part1 part2 get-input debugging?)

  (require threading)

  (define (get-input)
    (file->string "day14.txt"))

  (define debugging? (make-parameter #f))

  (define (dbg marker x)
    (when (debugging?)
      (printf "~a: ~a\n" marker x)
      (flush-output))
    x)

  (define (get-rock-range previous current)
    (if (empty? previous)
        null
        (let ([xs (first (filter (compose not empty?)
                                 (map range previous current (map (compose sgn -) current previous))))])
          (if (equal? (first previous) (first current))
              (map list (make-list (length xs) (first previous)) xs)
              (map list xs (make-list (length xs) (second previous)))))))

  (define (get-vec str)
    (map (compose string->number string-trim) (string-split str ",")))

  (define (v+ a b)
    (map + a b))

  (define (v- a b)
    (map - a b))

  (define (v=? a b)
    (and (= (first a) (first b))
         (= (second a) (second b))))

  (define (get-rocks input)
    (for/fold ([rocks (set)])
              ([line (string-split input "\n")])
      (for*/fold ([rocks rocks]
                  [previous-coordinate null]
                  #:result rocks)
                 ([r (string-split line "->")]
                  #:do [(define r-vec (get-vec r))]
                  [val (cons r-vec (get-rock-range previous-coordinate r-vec))])
        (values (set-add rocks val) r-vec))))

  (define (get-max-y cells)
    (for/fold ([max-y 0])
              ([cell cells])
      (max max-y (second cell))))

  (define (get-max-x cells)
    (for/fold ([max-x 0])
              ([cell cells])
      (max max-x (first cell))))

  (define (get-min-x cells)
    (for/fold ([min-x +inf.0]
               #:result (exact-round min-x))
              ([cell cells])
      (min min-x (first cell))))

  (define (draw-grid rocks all-cells)
    (define min-x (get-min-x all-cells))
    (define max-x (get-max-x all-cells))
    (define max-y (get-max-y all-cells))

    (list->string
     (cons #\newline
           (for*/list ([y (in-range (+ 1 max-y))]
                       [x (in-range min-x (+ 2 max-x))]
                       #:do [(define pos (list x y))])
             (cond
               [(set-member? rocks pos) #\#]
               [(set-member? all-cells pos) #\o]
               [(= x (+ 1 max-x)) #\newline]
               [else #\.])))))

  (define (part1 input)
    (define (settle-sand occupied-cells sand-position max-y)
      (define (is-occupied? pos)
        (set-member? occupied-cells pos))
      
      (if (> (second sand-position) max-y)
          (set-add occupied-cells sand-position)
          (if (is-occupied? (v+ sand-position '(0 1)))
              (if (is-occupied? (v+ sand-position '(-1 1)))
                  (if (is-occupied? (v+ sand-position '(1 1)))
                      (set-add occupied-cells sand-position)
                      (settle-sand occupied-cells (v+ sand-position '(1 1)) max-y))
                  (settle-sand occupied-cells (v+ sand-position '(-1 1)) max-y))
              (settle-sand occupied-cells (v+ sand-position '(0 1)) max-y))))

    (define rocks (get-rocks input))
    (define max-y (get-max-y rocks))

    (for/fold ([occupied-cells rocks]
               [num-iterations 0]
               #:result num-iterations)
              ([i (in-naturals)]
               #:do [(define new-cells (settle-sand occupied-cells '(500 0) max-y))
                     (define new-max-y (get-max-y new-cells))]
               #:break (> new-max-y max-y))
      (values new-cells (+ 1 num-iterations))))

  (define (part2 input)
    (define (settle-sand occupied-cells sand-position max-y)
      (define (is-occupied? pos)
        (set-member? occupied-cells pos))
      
      (if (= (second sand-position) (+ 1 max-y))
          (set-add occupied-cells sand-position)
          (if (is-occupied? (v+ sand-position '(0 1)))
              (if (is-occupied? (v+ sand-position '(-1 1)))
                  (if (is-occupied? (v+ sand-position '(1 1)))
                      (set-add occupied-cells sand-position)
                      (settle-sand occupied-cells (v+ sand-position '(1 1)) max-y))
                  (settle-sand occupied-cells (v+ sand-position '(-1 1)) max-y))
              (settle-sand occupied-cells (v+ sand-position '(0 1)) max-y))))

    (define rocks (dbg "rocks" (get-rocks input)))
    (define max-y (get-max-y rocks))
    (for/fold ([occupied-cells rocks]
               [num-iterations 0]
               #:result (begin
                          (call-with-output-file "sand.txt"
                            (λ (p)
                              (fprintf p "~a" (draw-grid rocks occupied-cells))))
                          num-iterations))
              ([i (in-naturals)]
               #:do [(define new-cells (settle-sand occupied-cells '(500 0) max-y))
                     (define new-max-y (get-max-y new-cells))]
               #:break (equal? occupied-cells new-cells))
      ;; (dbg "i" i)
      ;; (dbg "grid" (draw-grid rocks new-cells))
      (values new-cells (+ 1 num-iterations)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require 'day14)
(parameterize ([debugging? #f])
  (let ([input (get-input)])
    (list
     (time (part1 input))
     (time (part2 input)))))