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  | 
