day07

1 files changed, 82 insertions, 0 deletions

diff --git a/day07.lisp b/day07.lisp
new file mode 100644
index 0000000..a1fbeeb
--- /dev/null
+++ b/day07.lisp
@@ -0,0 +1,82 @@
+(defstruct hand cards bid)
+
+(defun parse-hands (filespec)
+  (with-open-file (stream filespec)
+    (loop for line = (read-line stream nil)
+          while line
+          as hand = (make-hand :cards (subseq line 0 5)
+                               :bid (parse-integer line :start 6))
+          collect hand)))
+
+(defun count-cards (cards &optional joker)
+  (let ((scards (sort (subseq cards 0) #'char<)))
+    (labels ((f (&optional (i 0) (count 0) last acc)
+               (if (= i (length scards))
+                   (cons count acc)
+                   (let ((c (aref scards i)))
+                     (if (and joker (char= c #\J))
+                         (f (1+ i) count last acc)
+                         (if last
+                             (if (char= c last)
+                                 (f (1+ i) (1+ count) c acc)
+                                 (f (1+ i) 1 c (cons count acc)))
+                             (f (1+ i) 1 c acc))))))
+             (count-jokers ()
+               (loop for card across cards
+                     count (char= #\J card))))
+      (let ((scount (sort (f) #'>)))
+        (if joker
+            (cons (+ (count-jokers) (car scount)) (cdr scount))
+            scount)))))
+
+(defun rank-cards (cards &optional joker)
+  (let ((count (count-cards cards joker)))
+    (cond ((equal '(5) count)         7)
+          ((equal '(4 1) count)       6)
+          ((equal '(3 2) count)       5)
+          ((equal '(3 1 1) count)     4)
+          ((equal '(2 2 1) count)     3)
+          ((equal '(2 1 1 1) count)   2)
+          ((equal '(1 1 1 1 1) count) 1))))
+
+(defun rank-char (char &optional joker)
+  (cond ((char= char #\A) 14)
+        ((char= char #\K) 13)
+        ((char= char #\Q) 12)
+        ((char= char #\J) (if joker 1 11))
+        ((char= char #\T) 10)
+        (t (digit-char-p char))))
+
+(defun lex-compare-cards (cards1 cards2 &optional joker)
+  (loop for i across cards1
+        for j across cards2
+        as ri = (rank-char i joker)
+        as rj = (rank-char j joker)
+        if (< ri rj)
+          return t
+        while (= ri rj)))
+
+(defun compare-hands (h1 h2 &optional joker)
+  (let* ((cards1 (hand-cards h1))
+         (cards2 (hand-cards h2))
+         (rank1 (rank-cards cards1 joker))
+         (rank2 (rank-cards cards2 joker)))
+    (or (< rank1 rank2)
+        (and (= rank1 rank2) (lex-compare-cards cards1 cards2 joker)))))
+
+(defun solve1 (f)
+  (let ((hands (sort (parse-hands f) #'compare-hands)))
+    (loop for i = 1 then (1+ i)
+          for hand in hands
+          sum (* i (hand-bid hand)))))
+
+(defun solve2 (f)
+  (let ((hands (sort (parse-hands f) (lambda (h1 h2) (compare-hands h1 h2 t)))))
+    (loop for i = 1 then (1+ i)
+          for hand in hands
+          sum (* i (hand-bid hand)))))
+
+(print (solve1 "data/07/example.txt")) ;; 6440
+(print (solve1 "data/07/input.txt"))   ;; 245794640
+(print (solve2 "data/07/example.txt")) ;; 5905
+(print (solve2 "data/07/input.txt"))   ;; 247899149