Commit Diff


commit - 5d92e811379726c6622a99576a2407cdddf8ec61
commit + 4f513a0cca5ca8b739ea096ef5a2ea843ef3cb8c
blob - c550718d41399f70c05dd1005689cabaeadec408
blob + 02e83a1841416481abc780269c7694c6bc3a59c1
--- src/day-7.lisp
+++ 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 *with-jokering* nil)
 
-(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))
-
 (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)))))
blob - 728ea5212493274e8465a43d7a6dabb7b131fdec
blob + 9c38c810f51595f5a93bf939e27a24aee4581e93
--- t/day-7.lisp
+++ 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)))