commit 4f513a0cca5ca8b739ea096ef5a2ea843ef3cb8c
parent 5d92e811379726c6622a99576a2407cdddf8ec61
Author: Lukas Henkel <lh@entf.net>
Date: Thu, 7 Dec 2023 07:28:03 +0100
Day 7 task 2
Diffstat:
2 files changed, 53 insertions(+), 26 deletions(-)
diff --git a/src/day-7.lisp b/src/day-7.lisp
@@ -16,35 +16,51 @@
(defparameter *cards* (nconc (list #\A #\K #\Q #\J #\T)
(loop for i from 9 downto 2 collect (code-char (+ i 48)))))
+(defparameter *cards-jokering* (nconc (list #\A #\K #\Q #\T)
+ (loop for i from 9 downto 2 collect (code-char (+ i 48)))
+ (list #\J)))
+
(defun card-strength (card)
(abs (- (position card *cards*) 13)))
-(defun make-pair-detector (length)
- (lambda (group)
- (= (length (cdr group)) length)))
-
-(defparameter *pair-detector-five* (make-pair-detector 5))
-(defparameter *pair-detector-four* (make-pair-detector 4))
-(defparameter *pair-detector-three* (make-pair-detector 3))
-(defparameter *pair-detector-two* (make-pair-detector 2))
+(defparameter *with-jokering* nil)
(defun hand-strength (hand)
- (let* ((groups (group-by hand
+ (let* ((groups (group-by (if *with-jokering*
+ (remove #\J hand)
+ hand)
:key #'identity
:value #'identity
:test #'char=))
- (three (find-if *pair-detector-three* groups))
- (n-pairs (length (remove-if-not *pair-detector-two* groups))))
- (cond
- ((some *pair-detector-five* groups) 70)
- ((some *pair-detector-four* groups) 60)
- ((and three
- (= n-pairs 1))
- 50)
- (three 40)
- ((= n-pairs 2) 30)
- ((= n-pairs 1) 20)
- (t (card-strength (first hand))))))
+ (groups (mapcar (lambda (group)
+ (1- (length group)))
+ groups))
+ (groups (sort groups #'>))
+ (n-jokers (when *with-jokering*
+ (count #\J hand))))
+ (when *with-jokering*
+ (when (= n-jokers 5)
+ (return-from hand-strength 70))
+ (setf groups
+ (loop for group in groups
+ for missing = (- 5 group)
+ for usable-jokers = (min missing n-jokers)
+ when (> missing 0)
+ do (incf group usable-jokers)
+ and do (decf n-jokers usable-jokers)
+ collect group)))
+ (let* ((n-pairs (count 2 groups))
+ (highest-sequence (first groups)))
+ (cond
+ ((= highest-sequence 5) 70)
+ ((= highest-sequence 4) 60)
+ ((and (= highest-sequence 3)
+ (= n-pairs 1))
+ 50)
+ ((= highest-sequence 3) 40)
+ ((= n-pairs 2) 30)
+ ((= n-pairs 1) 20)
+ (t (card-strength (first hand)))))))
(defun calculate-strengths (hands)
(loop for (hand bid) in hands
@@ -63,10 +79,20 @@
(card-strength card-2))))
(< strength-1 strength-2))))
-(defun day-7 (input)
- (let* ((hands-bids (parse-input input))
- (strength-hands-bids (calculate-strengths hands-bids))
+(defun total-winnings (hands-bids)
+ (let* ((strength-hands-bids (calculate-strengths hands-bids))
(strength-hands-bids (sort strength-hands-bids #'hand-strength<)))
(loop for (hand-strength hand bid) in strength-hands-bids
for rank from 1
sum (* bid rank))))
+
+(defmacro with-jokering (() &body body)
+ `(let ((*cards* *cards-jokering*)
+ (*with-jokering* t))
+ ,@body))
+
+(defun day-7 (input)
+ (let ((hands-bids (parse-input input)))
+ (values (total-winnings hands-bids)
+ (with-jokering ()
+ (total-winnings hands-bids)))))
diff --git a/t/day-7.lisp b/t/day-7.lisp
@@ -4,10 +4,11 @@
(define-test test-day-7
()
- (multiple-value-bind (task-1)
+ (multiple-value-bind (task-1 task-2)
(aoc:run-day 7 "32T3K 765
T55J5 684
KK677 28
KTJJT 220
QQQJA 483")
- (assert= 6440 task-1)))
+ (assert= 6440 task-1)
+ (assert= 5905 task-2)))
