diff options
-rw-r--r-- | day07.lisp | 82 |
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 |