summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--day07.lisp82
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