Day 14!

input/14.txt

@@ -0,0 +1,60 @@
+5 LKQCJ, 1 GDSDP, 2 HPXCL => 9 LVRSZ
+5 HPXCL, 5 PVJGF => 3 KZRTJ
+7 LVRSZ, 2 GFSZ => 5 FRWGJ
+9 ZPTXL, 5 HGXJH, 9 LQMT => 7 LVCXN
+2 LQMT, 2 PVJGF, 10 CKRVN => 9 VWJS
+2 VRMXL, 12 NBRCS, 2 WSXN => 7 GDSDP
+1 CKRP => 8 TBHVH
+1 SVMNB, 2 KZRTJ => 8 WKGQS
+6 LKQCJ, 8 HPXCL, 7 MPZH => 1 BQPG
+1 RCWL => 7 MPZH
+4 FGCMS, 2 LQMT, 1 LKQCJ => 1 KTBRM
+1 ZTCSK, 6 CXQB, 2 ZBZRT => 3 PVJGF
+7 DBNLM => 9 ZBZRT
+5 BGNQ, 2 WBPD, 5 KTBRM => 9 GFSZ
+6 XQBHG, 1 GPWVC => 8 CKFTS
+1 XWLQM, 29 XQBHG, 7 KPNWG => 5 BXVL
+6 TBHVH, 1 KTBRM => 7 HJGR
+1 LQMT, 14 KPNWG => 7 GPWVC
+18 LVCXN, 8 XVLT, 4 KPNWG, 13 LKQCJ, 12 MFJFW, 5 GZNJZ, 1 FLFT, 7 WBPD => 8 KZGD
+1 TBHVH => 1 VWKJ
+118 ORE => 2 CKRP
+2 LTCQX => 3 XQBHG
+1 GPWVC => 4 SMFQ
+6 CKRP => 4 RCWL
+39 LHZMD, 15 CKFTS, 26 HVBW, 57 KTBRM, 13 DFCM, 30 KZGD, 35 FPNB, 1 LKQCJ, 45 HJGR, 22 RCZS, 34 VWKJ => 1 FUEL
+1 BQPG, 2 BGNQ, 12 WBPD => 8 LTCQX
+2 WSXN => 2 HPXCL
+3 GRFPX => 5 XVLT
+1 LVRSZ => 3 SVMNB
+6 HLMT => 9 ZPTXL
+20 GFSZ => 5 GZNJZ
+1 RCWL => 9 KPNWG
+24 BGNQ, 31 KTBRM => 8 FLFT
+14 VSVG => 9 DBNLM
+191 ORE => 8 CXQB
+115 ORE => 2 SWVLZ
+17 KZRTJ, 13 KPNWG => 7 CKRVN
+9 BQPG => 4 XWLQM
+4 SMFQ, 2 GRFPX => 1 MFJFW
+6 CXQB, 4 CKRP, 2 BXVL, 5 GZNJZ, 3 VWJS, 1 FLFT, 4 KPNWG => 7 DFCM
+1 TBHVH => 6 BGNQ
+3 LQMT => 7 HLMT
+11 GDSDP => 4 WBPD
+2 KPNWG, 5 VWJS, 33 NBRCS => 7 NVDW
+5 GDSDP => 6 FGCMS
+1 GPWVC, 7 BGNQ, 1 FRWGJ => 8 GRFPX
+23 KTBRM, 11 VRMXL, 6 GPWVC => 5 SRJHK
+2 XQBHG, 1 GZNJZ => 3 HVBW
+1 ZTCSK => 4 WSXN
+1 XVLT, 5 HLMT, 1 ZPTXL, 2 HVBW, 7 NVDW, 1 WKGQS, 1 LTCQX, 5 MPZH => 3 FPNB
+16 SRJHK => 6 DWBW
+1 SVMNB, 1 VRMXL => 3 HGXJH
+133 ORE => 6 VSVG
+3 NBRCS, 1 FGCMS => 4 LQMT
+1 CKRP => 4 ZTCSK
+5 CKRVN, 1 FLFT => 1 RCZS
+4 ZTCSK, 15 RCWL => 9 LKQCJ
+1 SWVLZ => 8 NBRCS
+5 CKRP, 14 CXQB => 5 VRMXL
+1 SMFQ, 1 DWBW => 2 LHZMD

lib.rkt

@@ -16,6 +16,7 @@
          neq?
          nzero?
          negate
+         pos-or-zero
          number->digits-reverse
          number->digits
          rac
@@ -80,6 +81,10 @@
 (define (negate n)
   (- 0 n))
 
+;; pos-or-zero : number -> number
+(define (pos-or-zero n)
+  (if (negative? n) 0 n))
+
 ;; number->digits-reverse : number -> (listof number)
 ;; Return the digits of the given number in reverse order (i.e. RTL)
 (define (number->digits-reverse n)

src/14.rkt

@@ -0,0 +1,102 @@
+#lang racket
+
+(require graph
+         (except-in "../lib.rkt" transpose))
+
+(define input
+  (problem-input 14))
+
+(struct chemical (name amount) #:transparent)
+
+;; deps : directed, unweighted graph from products to reactants
+(define deps (unweighted-graph/directed '()))
+
+;; eqs : hashtable from products to (number . (list chemical))
+(define eqs (make-hash))
+
+;; parse-equation : string -> void
+;; Parses a string of the form "amt1 r1, ..., amtn rn => amtp p"
+;; and adds the equation to both deps and eqs
+(define (parse-equation! str)
+  (let* ([equation (string-split str " => ")]
+         [reactants (map (λ (s)
+                           (let ([ss (string-split s " ")])
+                             (chemical (string->symbol (second ss))
+                                       (string->number (first ss)))))
+                         (string-split (first equation) ", "))]
+         [product (string-split (second equation) " ")]
+         [product (chemical (string->symbol (second product))
+                            (string->number (first product)))])
+    (for-each
+     (λ (reactant)
+       (add-directed-edge! deps (chemical-name product) (chemical-name reactant)))
+     reactants)
+    (hash-set! eqs (chemical-name product) (cons (chemical-amount product) reactants))))
+
+;; add-reactants : product -> (overflow . chems) -> (overflow . chems)
+;; Given a product we want to produce, the amount we want is in chem;
+;; add the required reactants and amounts to chems while using as many
+;; overflow chemicals from previous loops as possible, and adding
+;; leftover products from reactions into the overflow
+(define (add-reactants product overflow-chems)
+  (define overflow (car overflow-chems))
+  (define chems (cdr overflow-chems))
+  (if (hash-has-key? chems product)
+      (let* ([have (hash-ref chems product)]
+             [eq (hash-ref eqs product)]
+             [need (car eq)]
+             [reactants (cdr eq)]
+             [multiple (ceiling (/ have need))]
+             [remaining (- (* multiple need) have)]
+             [overflow (hash-update overflow product (∂ + remaining) 0)]
+             [chems (hash-remove chems product)])
+        (foldl (λ (reactant oc)
+                 (let* ([overflow (car oc)]
+                        [chems (cdr oc)]
+                        [name (chemical-name reactant)]
+                        [need (* multiple (chemical-amount reactant))]
+                        [have (hash-ref overflow name 0)]
+                        [actual (pos-or-zero (- need have))]
+                        [overflow (hash-update overflow name (∂ - (- need actual)) 0)]
+                        [chems (hash-update chems name (∂ + actual) 0)])
+                   (cons overflow chems)))
+               (cons overflow chems) reactants))
+      overflow-chems))
+
+;; ore-needed : (listof products) -> (overflow . chems) -> number
+;; overflow : product => number
+;; chems : product => number
+;; Calculates the amount of ORE needed to produce the given list of products
+;; and the given list of available overflow reactants
+(define (ore-needed sorted overflow-chems)
+  (define overflow (car overflow-chems))
+  (define chems (cdr overflow-chems))
+  (if (and (= 1 (hash-count chems))
+           (hash-has-key? chems 'ORE))
+      (hash-ref chems 'ORE)
+      (let* ([overflow-chems (foldl add-reactants overflow-chems sorted)])
+        (ore-needed sorted overflow-chems))))
+
+(define toposorted
+  (begin
+    (for-each parse-equation! input)
+    (remove 'ORE (tsort deps))))
+
+(define part1
+  (ore-needed toposorted (cons (make-immutable-hash '()) (make-immutable-hash '((FUEL . 1))))))
+
+;; Binary search using the ore amount from part 1 to get a fuel lower bound
+;; (i.e. overestimating ore needed) and twice of that as an upper bound
+(define part2
+  (let loop ([lower (floor (/ 1000000000000 part1))]
+             [upper (* 2 (floor (/ 1000000000000 part1)))])
+    (if (= 1 (- upper lower)) lower
+        (let* ([mid (+ (floor (/ (- upper lower) 2)) lower)]
+               [ore (ore-needed toposorted
+                                (cons (make-immutable-hash '())
+                                      (make-immutable-hash `((FUEL . ,mid)))))])
+          (if (> ore 1000000000000)
+              (loop lower mid)
+              (loop mid upper))))))
+
+(show-solution part1 part2)