Add 2023/07

src/2023/day07.lisp

@@ -0,0 +1,87 @@
+(defpackage :aoc/2023/07 #.cl-user::*aoc-use*)
+(in-package :aoc/2023/07)
+
+
+(defun list-of-hands (&optional (strings (uiop:read-file-lines #P"src/2023/day07.txt")))
+  (mapcar (lambda(s)
+            (destructuring-bind (hand bid)
+                (split-sequence:split-sequence #\Space s)
+              (cons hand (parse-integer bid))))
+          strings))
+#+#:excluded (list-of-hands)
+
+(defparameter *labels* "AKQJT98765432")
+
+(defun five-of-a-kind? (hand)
+  (some [= (cdr _) 5] (frequencies hand)))
+#+#:excluded (five-of-a-kind? "AAAAA")
+(defun four-of-a-kind? (hand)
+  (some [= (cdr _) 4] (frequencies hand)))
+#+#:excluded (four-of-a-kind? "AAAA8")
+(defun full-house? (hand)
+  (bnd1 (ff (frequencies hand))
+    (and (find-if [= (cdr _) 3] ff)
+         (find-if [= (cdr _) 2] ff))))
+#+#:excluded (full-house? "AAABB")
+(defun three-of-a-kind? (hand)
+  (bnd1 (ff (frequencies hand))
+    (and (find-if [= (cdr _) 3] ff)
+         (find-if [= (cdr _) 1] ff))))
+#+#:excluded (three-of-a-kind? "AAA18")
+(defun two-pairs? (hand)
+  (bnd1 (ff (frequencies hand))
+    (aand (member-if [= (cdr _) 2] ff)
+          (member-if [= (cdr _) 2] (cdr it)))))
+#+#:excluded (two-pairs? "AABB1")
+(defun one-pair? (hand)
+  (bnd1 (ff (frequencies hand))
+    (and (= (length ff) 4)
+         (find-if [= (cdr _) 2] ff))))
+#+#:excluded (one-pair? "AAB12")
+(defun high-card? (hand)
+  (every [= (cdr _) 1] (frequencies hand)))
+#+#:excluded (high-card? "23456")
+
+(defun hand-strength (hand)
+  (cond ((five-of-a-kind? hand) 1)
+        ((four-of-a-kind? hand) 2)
+        ((full-house? hand) 3)
+        ((three-of-a-kind? hand) 4)
+        ((two-pairs? hand) 5)
+        ((one-pair? hand) 6)
+        ((high-card? hand) 7)))
+#+#:excluded (hand-strength "33332")
+#+#:excluded (hand-strength "2AAAA")
+(defun better-hand? (hand1 hand2)
+  (bnd* ((r1 (hand-strength hand1))
+         (r2 (hand-strength hand2)))
+    (or (< r1 r2)
+        (and (= r1 r2)
+             (loop for l1 across hand1 for i = (position l1 *labels*)
+                   for l2 across hand2 for j = (position l2 *labels*)
+                   if (< i j) return t
+                   if (> i j) return nil
+                   )))))
+#+#:excluded (better-hand? "33332"  "2AAAA")
+
+(looping
+  (dolist+ ((i (hand . bid)) (enumerate (reverse (sort (list-of-hands) #'better-hand? :key #'car))))
+    (sum! (* (1+ i) bid))))
+251813756;not right
+251741086; not right
+251806792
+
+(defparameter *labels* "AKQT98765432J")
+(defun hand-strength-p2 (hand)
+  (if (not (find #\J hand))
+    (cond ((five-of-a-kind? hand) 1)
+          ((four-of-a-kind? hand) 2)
+          ((full-house? hand) 3)
+          ((three-of-a-kind? hand) 4)
+          ((two-pairs? hand) 5)
+          ((one-pair? hand) 6)
+          ((high-card? hand) 7))
+    (looping
+      (doseq (l "AKQT98765432")
+        (minimize! (hand-strength (substitute l #\J hand)))))))
+252113488