path: root/day07.lisp

(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