Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
(defpackage :advent.2019.14
(:use :cl :alexandria :cl-ppcre)
(:import-from :series #:collect #:map-fn #:scan-stream))
(in-package :advent.2019.14)
(defun parse-reactions (stream)
(labels ((reaction (line)
(destructuring-bind (in out) (split " => " line)
(mapcar #'compound (list* out (split ", " in)))))
(compound (s)
(register-groups-bind (amount (#'intern unit)) ("(\\d+) (\\w+)" s)
(export unit *package*)
(cons unit (parse-integer amount)))))
(collect 'list (map-fn t #'reaction (scan-stream stream #'read-line)))))
(defmacro with-rule ((unit quantity deps) rule &body body)
(loop
for s in (list unit quantity deps)
for i = (or (null s) (starts-with #\_ (string s)))
for v = (if i (copy-symbol s) s)
collect v into variables
when i collect v into ignored
finally
(return
(destructuring-bind (unit quantity deps) variables
`(destructuring-bind ((,unit . ,quantity) . ,deps) ,rule
,@(and ignored `((declare (ignore ,@ignored))))
,@body)))))
(defmacro quantity (unit state)
`(gethash ,unit ,state 0))
(defmacro state (&rest plist)
`(plist-hash-table (list ,@plist)))
(defun cleanup (hash)
(maphash (lambda (u q) (when (zerop q) (remhash u hash))) hash))
(defun show (state)
(print (hash-table-plist state)))
(defun backward-apply-rule (state rule)
(with-rule (u q deps) rule
(let ((avail (quantity u state)))
(dotimes (i (if (> q avail) 1 (floor avail q)) (cleanup state))
(decf (quantity u state) q)
(loop for (u . q) in deps do (incf (quantity u state) q))))))
(defun find-rules (unit rules)
(remove unit rules :test-not #'eq :key #'caar))
(defun rule-quantity (rule)
(with-rule (_ q _) rule q))
(defun backward-sort-rules (state rules &aux waste normal)
(maphash (lambda (unit quantity)
(when (plusp quantity)
(dolist (rule (find-rules unit rules))
(with-rule (_ need _) rule
(if (> need quantity)
(push rule waste)
(push rule normal))))))
state)
(nconc (sort normal #'> :key #'rule-quantity)
(sort waste #'< :key #'rule-quantity)))
(defun backward (state rules callback)
(declare (type function callback) (optimize (speed 3)))
(when-let (rule (first (backward-sort-rules state rules)))
(funcall callback (backward-apply-rule state rule))))
(defun visit (state rules next cb sp)
(declare (type function cb sp next) (optimize (speed 3)))
(flet ((visit% (s) (visit s rules next cb sp)))
(if (funcall sp state)
(funcall cb state)
(funcall next state rules #'visit%))))
(defun solve/1 (rules &optional (state (state 'fuel 1)))
(block nil
(flet ((solutionp (state)
(loop
for u being the hash-keys of state using (hash-value q)
always (case u (ore (plusp q)) (t (minusp q)))))
(leaf (state) (return (quantity 'ore state))))
(visit state rules #'backward #'leaf #'solutionp))))
(solve/1 *test* (state 'fuel 1))
(solve/1 (with-open-file (in #P"14.in") (parse-reactions in)) (state 'fuel 1))
198984
(floor 1000000000000 198984)
5025529
(solve/1 (with-open-file (in #P"14.in") (parse-reactions in))
(state 'fuel 5025529))
=> 656097240338
(defvar *step1* (copy-hash-table *))
(floor (- (* 5025529 (/ 1000000000000 656097240338))
5025529))
2634202
314584285461/328048620169
(defmacro state* (original &rest more)
(with-gensyms (cp k v)
`(let ((,cp (copy-hash-table ,original)))
(prog1 ,cp
(maphash (lambda (,k ,v) (setf (gethash ,k ,cp) ,v))
(state ,@more))))))
(solve/1 (with-open-file (in #P"14.in") (parse-reactions in))
(state* *step1* 'fuel 2634202))
999999830210
(solve/1 (with-open-file (in #P"14.in") (parse-reactions in))
(state* *step2* 'fuel 1))
999999960130
T
(solve/1 (with-open-file (in #P"14.in") (parse-reactions in))
(state* *step2* 'fuel 2))
1000000107196
T
(+ 5025529 1 2634202)
7659732
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.