194 lines
7.9 KiB
Common Lisp
194 lines
7.9 KiB
Common Lisp
;; https://adventofcode.com/2022/day/19
|
|
(defpackage :day-19
|
|
(:use :cl))
|
|
(in-package :day-19)
|
|
|
|
(ql:quickload 'cl-ppcre)
|
|
|
|
(defparameter *all-types* '(:geode :obsidian :clay :ore))
|
|
|
|
(defclass state ()
|
|
((resources :accessor resources :initform nil :initarg :resources)
|
|
(robots :accessor robots :initform (list :ore 1) :initarg :robots)
|
|
(minute :accessor minute :initarg :minute :initform 1 )
|
|
(cur-found-max :initform nil :accessor cur-found-max :allocation :class) ; would be nice to add types
|
|
))
|
|
|
|
(defmethod print-object ((obj state) stream)
|
|
(print-unreadable-object (obj stream :type t)
|
|
(with-slots (resources robots)
|
|
obj
|
|
(format stream "collected: ~a, with robots: ~a"
|
|
resources robots))))
|
|
|
|
;; example of blueprint:
|
|
(defparameter *test-blueprint*
|
|
'(:ore (:ore 4)
|
|
:clay (:ore 2)
|
|
:obsidian (:ore 3 :clay 14)
|
|
:geode (:ore 2 :obsidian 7)))
|
|
|
|
;; thank you blambert & stackoverflow
|
|
;; https://stackoverflow.com/questions/11067899/is-there-a-generic-method-for-cloning-clos-objects
|
|
;; oh, but this is shallow copy and lists reused. crap
|
|
|
|
(defmethod copy-state ((s state))
|
|
(make-instance 'state :resources (copy-list (resources s))
|
|
:robots (copy-list (robots s))
|
|
:minute (minute s)))
|
|
|
|
(defmethod can-create-robot (blueprints type (s state))
|
|
(let ((this-robot-costs (getf blueprints type)))
|
|
(loop for (resource amount) on this-robot-costs by #'cddr
|
|
always (>= (getf (resources s) resource 0) amount))))
|
|
|
|
(defmethod create-robot (blueprints type (s state))
|
|
(when (can-create-robot blueprints type s)
|
|
(let ((this-robot-costs (getf blueprints type))
|
|
(copied-state (copy-state s)))
|
|
(loop for (resource amount) on this-robot-costs by #'cddr
|
|
do (incf (getf (resources copied-state) resource 0) (- amount)))
|
|
(incf (getf (robots copied-state) type 0))
|
|
copied-state)))
|
|
|
|
(defmethod calc-resources-to-be-collected ((s state))
|
|
(robots s))
|
|
|
|
(defmethod add-resources (new-resources (s state))
|
|
(loop for (resource amount) on new-resources by #'cddr
|
|
do (incf (getf (resources s) resource 0) amount)))
|
|
|
|
;; robot is unnecessary if resouce it brings is alreay produced
|
|
;; at amount of maximal possible per-turn expence
|
|
(defmethod max-need (blueprints (s state) resource-type)
|
|
(loop
|
|
for (la blueprint) on blueprints by #'cddr
|
|
;; do (print blueprint)
|
|
maximize (getf blueprint resource-type 0)))
|
|
|
|
(defmethod any-use-of-creating-robot (blueprints (s state) robot-type)
|
|
(if (eq :geode robot-type)
|
|
t ; always reason to build more geode robots
|
|
(let ((max-need (max-need blueprints s robot-type))
|
|
(state-production (getf (robots s) robot-type 0)))
|
|
;; (format t "comparing need ~a with prod ~a" max-need state-production)
|
|
(> max-need state-production))))
|
|
|
|
(defmethod get-possible-bot-builds (blueprints (s state))
|
|
(remove-if-not (lambda (robot-type)
|
|
(any-use-of-creating-robot blueprints s robot-type))
|
|
(remove-if-not (lambda (robot-type)
|
|
(can-create-robot blueprints robot-type s))
|
|
*all-types*)))
|
|
|
|
;; true when no longer need to build secondary robots
|
|
(defmethod is-satiated-p (blueprints (s state))
|
|
(loop for type in '(:ore :clay :obsidian)
|
|
never (any-use-of-creating-robot blueprints s type)))
|
|
|
|
(defmethod a-dominates-b-p (blueprints (a state) (b state))
|
|
;; (declare (optimize (debug 3)))
|
|
(when (is-satiated-p blueprints a) ; when not a satiated - don't know
|
|
(and
|
|
(<= (minute a) (minute b)) ; a earlier than b
|
|
(or
|
|
(not (is-satiated-p blueprints b))
|
|
(loop for resource-type in *all-types* ; for both satiated compare all resources
|
|
always (and (>= (getf (resources a) resource-type 0)
|
|
(getf (resources b) resource-type 0))
|
|
(>= (getf (robots a) resource-type 0)
|
|
(getf (robots b) resource-type 0))))))))
|
|
|
|
;; loose bound on geodes
|
|
(defmethod estimate ((s state))
|
|
(let ((time-left (- 25 (minute s))))
|
|
(+ (getf (resources s) :geode 0)
|
|
(* time-left (getf (robots s) :geode 0))
|
|
(/ (* time-left (1- time-left)) 2))))
|
|
|
|
(defmethod find-max-geod-2 (blueprints (s state))
|
|
(declare (optimize (speed 3)))
|
|
;; (declare (optimize (debug 3)))
|
|
;; (format t "in step for ~a; with ~a~%" (minute s) s)
|
|
(cond
|
|
(
|
|
(= 33 (minute s)) ; exit condition fully calculated
|
|
;; (= 25 (minute s)) ; exit condition fully calculated
|
|
(getf (resources s) :geode 0))
|
|
((< (estimate s) (cur-found-max s))
|
|
;; (print "pruning")
|
|
0) ; pruning this branch
|
|
(t ; default check
|
|
(progn
|
|
(let* ((will-collect-this-minute (calc-resources-to-be-collected s))
|
|
(possible-bot-builds (get-possible-bot-builds blueprints s))
|
|
(max-if-building
|
|
(when possible-bot-builds
|
|
(loop
|
|
for bot-type in possible-bot-builds
|
|
for state-with-new-bot = (create-robot blueprints bot-type s)
|
|
when state-with-new-bot
|
|
maximize (progn
|
|
(add-resources will-collect-this-minute state-with-new-bot)
|
|
(incf (minute state-with-new-bot))
|
|
(find-max-geod-2 blueprints state-with-new-bot )))))
|
|
(if-not-building
|
|
(let ((state-copy (copy-state s)))
|
|
;; (break)
|
|
(add-resources will-collect-this-minute state-copy)
|
|
(incf (minute state-copy))
|
|
(find-max-geod-2 blueprints state-copy )))
|
|
(recursed-max (max (or max-if-building 0) if-not-building)))
|
|
;; (break)
|
|
;; (format t "would build ~a~%" possible-bot-builds)
|
|
(when (> recursed-max (cur-found-max s))
|
|
(setf (cur-found-max s) recursed-max))
|
|
recursed-max
|
|
)))))
|
|
|
|
|
|
(defun blueprint-line-to-plist (line)
|
|
(destructuring-bind
|
|
(ore-cost-in-ore clay-cost-in-ore obs-cost-in-ore obs-cost-in-clay
|
|
geod-cost-in-ore geod-cost-in-obs)
|
|
(rest (remove-if-not #'identity
|
|
(mapcar (lambda (str) (parse-integer str :junk-allowed t))
|
|
(ppcre:split " " line))))
|
|
`(:ore (:ore ,ore-cost-in-ore)
|
|
:clay (:ore ,clay-cost-in-ore)
|
|
:obsidian (:ore ,obs-cost-in-ore :clay ,obs-cost-in-clay)
|
|
:geode (:ore ,geod-cost-in-ore :obsidian ,geod-cost-in-obs))))
|
|
|
|
(defun read-and-calc-part-1 (filename)
|
|
(with-open-file (in filename)
|
|
(loop
|
|
for line = (read-line in nil nil)
|
|
for n from 1
|
|
for blueprints = (when line (blueprint-line-to-plist line))
|
|
for max-geo = (when blueprints
|
|
(progn
|
|
(setf (cur-found-max *test-state*)
|
|
0)
|
|
(format t "Starting processing for ~a" line)
|
|
(timing (find-max-geod-2 blueprints (make-instance 'state)))))
|
|
while blueprints
|
|
do (format t "processed ~a. its max is ~a~%" n max-geo)
|
|
summing (* n max-geo))))
|
|
|
|
(defun read-and-calc-part-2 (filename)
|
|
(with-open-file (in filename)
|
|
(loop
|
|
for line = (read-line in nil nil)
|
|
for n from 1
|
|
for blueprints = (when line (progn
|
|
(format t "Starting processing for ~a~%" line)
|
|
(blueprint-line-to-plist line)))
|
|
for max-geo = (when blueprints
|
|
(progn
|
|
(setf (cur-found-max *test-state*) 0)
|
|
(timing (find-max-geod-2 blueprints (make-instance 'state)))))
|
|
while blueprints
|
|
do (format t "processed ~a. its max is ~a~%" n max-geo)
|
|
collecting max-geo into maxes
|
|
finally (return (apply #'* maxes)))))
|