93e58c23c4f8ec2dc0dbfb0c708df6133207c0ba — T T 7 months ago 7cd525c
Day 24
3 files changed, 279 insertions(+), 1 deletions(-)

M aoc18.asd
A day24.input
A day24.lisp
M aoc18.asd => aoc18.asd +2 -1
@@ 37,4 37,5 @@ (:file "day20")
  	       (:file "day21")
  	       (:file "day22")
- 	       (:file "day23")))
+ 	       (:file "day23")
+ 	       (:file "day24")))

A day24.input => day24.input +23 -0
@@ 0,0 1,23 @@
+ Immune System:
+ 3115 units each with 1585 hit points (weak to slashing, bludgeoning) with an attack that does 4 slashing damage at initiative 7
+ 3866 units each with 6411 hit points (weak to cold, radiation; immune to fire) with an attack that does 14 slashing damage at initiative 11
+ 40 units each with 10471 hit points (weak to bludgeoning, slashing; immune to cold) with an attack that does 2223 cold damage at initiative 3
+ 1923 units each with 2231 hit points (weak to slashing, fire) with an attack that does 10 bludgeoning damage at initiative 13
+ 4033 units each with 10164 hit points (immune to slashing) with an attack that does 22 radiation damage at initiative 5
+ 36 units each with 5938 hit points (weak to bludgeoning, cold; immune to fire) with an attack that does 1589 slashing damage at initiative 4
+ 2814 units each with 7671 hit points (weak to cold) with an attack that does 21 radiation damage at initiative 15
+ 217 units each with 9312 hit points (immune to slashing) with an attack that does 345 radiation damage at initiative 8
+ 38 units each with 7686 hit points (weak to bludgeoning) with an attack that does 1464 radiation damage at initiative 14
+ 5552 units each with 3756 hit points (weak to slashing) with an attack that does 6 fire damage at initiative 10
+ 
+ Infection:
+ 263 units each with 28458 hit points (weak to fire, radiation) with an attack that does 186 cold damage at initiative 9
+ 137 units each with 29425 hit points (immune to fire; weak to cold) with an attack that does 367 radiation damage at initiative 1
+ 2374 units each with 41150 hit points (immune to bludgeoning, slashing, radiation; weak to cold) with an attack that does 34 bludgeoning damage at initiative 6
+ 1287 units each with 24213 hit points (immune to fire) with an attack that does 36 cold damage at initiative 17
+ 43 units each with 32463 hit points (weak to radiation; immune to slashing, bludgeoning) with an attack that does 1347 fire damage at initiative 16
+ 140 units each with 51919 hit points (weak to slashing, bludgeoning) with an attack that does 633 fire damage at initiative 12
+ 3814 units each with 33403 hit points with an attack that does 15 fire damage at initiative 19
+ 3470 units each with 44599 hit points (weak to slashing, radiation) with an attack that does 23 radiation damage at initiative 18
+ 394 units each with 36279 hit points with an attack that does 164 fire damage at initiative 20
+ 4288 units each with 20026 hit points with an attack that does 7 radiation damage at initiative 2

A day24.lisp => day24.lisp +254 -0
@@ 0,0 1,254 @@
+ (in-package :aoc18)
+ 
+ (defstruct unit
+   (count 0 :type fixnum)
+   (hp 0 :type fixnum)
+   (weak '())
+   (immune '())
+   (attack 0 :type fixnum)
+   (attack-type nil)
+   (initiative 0 :type fixnum))
+ 
+ (defun effective-power (unit)
+   (* (unit-count unit) (unit-attack unit)))
+ 
+ (defun potential-damage (attacker defender)
+   (let ((a-type (unit-attack-type attacker))
+ 	(d-immun (unit-immune defender))
+ 	(d-weak (unit-weak defender))
+ 	(base-dmg (effective-power attacker)))
+     (cond
+       ((find a-type d-immun :test #'equalp) 0)
+       ((find a-type d-weak :test #'equalp) (* 2 base-dmg))
+       (t base-dmg))))
+ 
+ (defun apply-dmg (unit dmg)
+   (let* ((copy (copy-structure unit))
+ 	 (units-killed (floor (/ dmg (unit-hp copy))))
+ 	 (new-units (- (unit-count copy) units-killed)))
+     (when (<= new-units 0)
+       (return-from apply-dmg (values nil (unit-count copy))))
+     (setf (unit-count copy) new-units)
+     (values copy units-killed)))
+ 
+ (defun selection-order (u1 u2)
+   (let ((ep1 (effective-power u1))
+ 	(ep2 (effective-power u2)))
+     (cond
+       ((> ep1 ep2) t)
+       ((= ep1 ep2) (> (unit-initiative u1) (unit-initiative u2))))))
+ 
+ (defun parse-unit-props (props)
+   (let ((weak nil)
+ 	(immune nil))
+     (cl-ppcre:register-groups-bind (list) ("weak to ([^;]*)(;|$)" props)
+       (when list
+ 	(setf weak (cl-ppcre:split ", " list))))
+     (cl-ppcre:register-groups-bind (list) ("immune to ([^;]*)(;|$)" props)
+       (when list
+ 	(setf immune (cl-ppcre:split ", " list))))
+     (values weak immune)))
+ 
+ (defun parse-unit (line)
+   (cl-ppcre:register-groups-bind ((#'parse-integer count hp) props (#'parse-integer attack) type (#'parse-integer initiative))
+       ("(.*) units each with (.*) hit points \\((.*)\\) with an attack that does (.*) (.*) damage at initiative (.*)" line)
+     (when props
+       (multiple-value-bind (weak immune) (parse-unit-props props)
+ 	(return-from parse-unit
+ 	  (make-unit :count count :hp hp :weak weak :immune immune :attack attack :attack-type type :initiative initiative)))))
+   (cl-ppcre:register-groups-bind ((#'parse-integer count hp attack) type (#'parse-integer initiative))
+       ("(.*) units each with (.*) hit points with an attack that does (.*) (.*) damage at initiative (.*)" line)
+     (make-unit :count count :hp hp :weak '() :immune '() :attack attack :attack-type type :initiative initiative)))
+ 
+ (defun parse-day24-input (path)
+   (let* ((lines (remove-if #'empty-p (read-lines path)))
+ 	 (immune '())
+ 	 (infection '())
+ 	 (current 'immune))
+     (loop for line in lines do
+ 	 (cond
+ 	   ((string-equal "Immune System:" line) (setf current 'immune))
+ 	   ((string-equal "Infection:" line) (setf current 'infection))
+ 	   (t (let ((unit (parse-unit line)))
+ 		(if (eql current 'immune)
+ 		    (push unit immune)
+ 		    (push unit infection))
+ 		(unless unit
+ 		  (format t "line: ~a~%~a~%" line (parse-unit line)))))))
+     (values (make-array (length immune) :initial-contents (reverse immune))
+ 	    (make-array (length infection) :initial-contents (reverse infection)))))
+ 
+ (defstruct game
+   (immune #())
+   (infection #()))
+ 
+ (defun parse-game (path)
+   (multiple-value-bind (immune infection) (parse-day24-input path)
+     (make-game :immune immune :infection infection)))
+ 
+ (defun print-game (g)
+   (format t "Immune System:~%")
+   (loop for i from 0 below (length (game-immune g)) do
+        (when (aref (game-immune g) i)
+ 	 (format t "Group ~a containt ~a units~%" (1+ i) (unit-count (aref (game-immune g) i)))))
+   (format t "Infection:~%")
+   (loop for i from 0 below (length (game-infection g)) do
+        (when (aref (game-infection g) i)
+ 	 (format t "Group ~a containt ~a units~%" (1+ i) (unit-count (aref (game-infection g) i))))))
+ 
+ (defun print-potential-dmg (aname attackers defenders)
+   (loop for ai from 0 below (length attackers) do
+        (loop for di from 0 below (length defenders) do
+ 	    (when (and (aref attackers ai) (aref defenders di))
+ 	      (format t "~a group ~a would deal defending group ~a ~a damage~%"
+ 		      aname (1+ ai) (1+ di) (potential-damage (aref attackers ai) (aref defenders di)))))))
+ 
+ (defun other-tag (tag)
+   (when (eql tag 'immune) (return-from other-tag 'infection))
+   (when (eql tag 'infection) 'immune))
+ 
+ (defun arr-by-tag (tag immune infection)
+   (if (eql tag 'immune) immune infection))
+ 
+ (defun game-ended (g)
+   (with-slots (immune infection) g
+     (when (= (count-if-not #'null immune) 0)
+       (return-from game-ended 'infection))
+     (when (= (count-if-not #'null infection) 0)
+       (return-from game-ended 'immune))))
+ 
+ (defun total-units-in-game (g)
+   (+ (apply #'+ (map 'list #'unit-end-score (game-immune g)))
+      (apply #'+ (map 'list #'unit-end-score (game-infection g)))))
+ 
+ (defun unit-end-score (u)
+   (if u (unit-count u) 0))
+ 
+ 
+ 
+ (defun game-many-turns (g)
+   (let ((current g)
+ 	(previous-units (total-units-in-game g)))
+     (loop while (not (game-ended current)) do
+ 	 (setf current (game-turn current))
+ 	 (let ((current-units (total-units-in-game current)))
+ 	   (if (= current-units previous-units)
+ 	       (return-from game-many-turns 'loop)
+ 	       (setf previous-units current-units))))
+     (with-slots (immune infection) current
+       (values (+ (apply #'+ (map 'list #'unit-end-score immune))
+ 		 (apply #'+ (map 'list #'unit-end-score infection)))
+ 	      (game-ended current)))))
+ 
+ (test day24-part1
+   (is (= 14854 (game-many-turns (parse-game "day24.input")))))
+ 
+ (defun apply-boost (g boost)
+   (loop for unit across (game-immune g) do
+        (incf (unit-attack unit) boost))
+   g)
+ 
+ (defun game-turn (g)
+   ;;(format t "TURN START~%")
+   ;;(print-game g)
+   ;;(format t "~%")
+   ;;(print-potential-dmg "Infection" (game-infection g) (game-immune g))
+   ;;(print-potential-dmg "Immune System" (game-immune g) (game-infection g))
+ 
+   (let ((attacks (make-hash-table :test #'equalp))
+ 	(infection-order (find-selection-order (game-infection g)))
+ 	(immune-order (find-selection-order (game-immune g))))
+     (select-all-targets 'infection (game-infection g) infection-order (game-immune g) attacks)
+     (select-all-targets 'immune (game-immune g) immune-order (game-infection g) attacks)
+     (loop for attack in (attack-order (game-immune g) (game-infection g)) do
+ 	 (when (gethash attack attacks)
+ 	   (with-slots (immune infection) g
+ 	     (let* ((attacker (get-unit-by-tag attack immune infection))
+ 		    (defender (get-unit-by-tag (gethash attack attacks) immune infection))
+ 		    (defender-idx (cdr (gethash attack attacks)))
+ 		    (defender-tag (car (gethash attack attacks)))
+ 		    (dmg (and attacker defender (potential-damage attacker defender))))
+ 	       (when (and attacker defender)
+ 		 (multiple-value-bind (new-defender killed) (apply-dmg defender dmg)
+ 		   ;; (format t "attack ~a of ~a killing ~a with dmg ~a vs hp ~a~%" attack (gethash attack attacks) killed dmg (unit-hp defender))
+ 		   (setf (aref (arr-by-tag defender-tag immune infection) defender-idx) new-defender))))))))
+   g)
+ 
+ (defun select-target (attacker defenders already-attacked)
+   (let ((selected nil)
+ 	(best-dmg 0)
+ 	(selected-effective 0)
+ 	(selected-initiative 0))
+     (loop for i from 0 below (length defenders) do
+ 	 (when (aref defenders i)
+ 	   ;; TODO check for nil
+ 	   (unless (find i already-attacked)
+ 	     (let ((dmg (potential-damage attacker (aref defenders i)))
+ 		   (effective (effective-power (aref defenders i)))
+ 		   (initiative (unit-initiative (aref defenders i))))
+ 	       ;; (format t "attacker ~a considers dealing ~a to effective ~a initiative ~a~%" attacker dmg effective initiative)
+ 	       (when (> dmg 0)
+ 		 (when (and (= dmg best-dmg) (= effective selected-effective) (> initiative selected-initiative))
+ 		   (setf selected i
+ 			 best-dmg dmg
+ 			 selected-effective effective
+ 			 selected-initiative initiative))
+ 		 (when (and (= dmg best-dmg) (> effective selected-effective))
+ 		   (setf selected i
+ 			 best-dmg dmg
+ 			 selected-effective effective
+ 			 selected-initiative initiative))
+ 		 (when (> dmg best-dmg)
+ 		   (setf selected i
+ 			 best-dmg dmg
+ 			 selected-effective effective
+ 			 selected-initiative initiative)))))))
+     ;; (format t "~a selected ~a~%" attacker selected)
+     selected))
+ 
+ (defun select-all-targets (tag attackers selection-order defenders map)
+   ;;(assert (= (length attackers) (length selection-order)))
+   (let ((attacked '()))
+     (loop for ai in selection-order do
+ 	 (when (aref attackers ai)
+ 	   (let ((di (select-target (aref attackers ai) defenders attacked)))
+ 	     (when di
+ 	       (push di attacked)
+ 	       (setf (gethash (cons tag ai) map) (cons (other-tag tag) di))))))
+     map))
+ 
+ (defun find-selection-order (attackers)
+   (labels
+       ((get-real (u)
+ 	 (aref attackers u))
+        (selection-ord (u1 u2)
+ 	 (selection-order (get-real u1) (get-real u2))))
+     (let ((indexes '()))
+       (loop for i from 0 below (length attackers) do
+ 	   (when (get-real i)
+ 	     (push i indexes)))
+       (sort indexes #'selection-ord))))
+ 
+ (defun get-unit-by-tag (p immune infection)
+   (if (eql 'immune (car p))
+       (aref immune (cdr p))
+       (aref infection (cdr p))))
+ 
+ (defun attack-order (immune infection)
+   (let ((ret '()))
+     (loop for i from 0 below (length immune) do
+ 	 (when (aref immune i)
+ 	   (push (cons 'immune i) ret)))
+     (loop for i from 0 below (length infection) do
+ 	 (when (aref infection i)
+ 	   (push (cons 'infection i) ret)))
+     (sort ret #'> :key #'(lambda (p) (unit-initiative  (get-unit-by-tag p immune infection))))))
+ 
+ (defun find-boost (path)
+   (loop for boost from 0 do
+        (multiple-value-bind (score who) (game-many-turns (apply-boost (parse-game path) boost))
+ 	 (when (eql 'immune who)
+ 	   (return-from find-boost (values score boost))))))
+ 
+ (test day24-part2
+   (is (= 3467 (find-boost "day24.input"))))