advent-of-code-2023

My solutions to AoC 2023
git clone git://git.entf.net/advent-of-code-2023
Log | Files | Refs

day-7.lisp (4781B)

      1 (defpackage #:aoc/day-7
      2   (:use #:cl #:aoc/utils)
      3   (:export #:day-7))
      4 (in-package #:aoc/day-7)
      5 
      6 (defstruct hand-data
      7   (hand "" :type simple-string)
      8   (bid 0 :type fixnum)
      9   (hand-strength -1 :type fixnum)
     10   (cards-strength -1 :type fixnum))
     11 
     12 (declaim (ftype (function (simple-string) hand-data) parse-hand-data))
     13 (defun parse-hand-data (line)
     14   (let ((pos (position #\Space line)))
     15     (make-hand-data :hand (subseq line 0 pos)
     16                     :bid (parse-integer line :start (1+ pos)))))
     17 
     18 (defun parse-input (input)
     19   (loop for line = (read-line input nil)
     20         while line
     21         collect (parse-hand-data line)))
     22 
     23 (declaim (type (simple-array fixnum) *cards*))
     24 (defparameter *cards*
     25   (make-array
     26    35
     27    :element-type 'fixnum
     28    :initial-contents (loop for card from 50 to 84
     29                            collect (or (case (code-char card)
     30                                          (#\A 13) (#\K 12) (#\Q 11) (#\J 10) (#\T 9)
     31                                          (#\9 8) (#\8 7) (#\7 6) (#\6 5) (#\5 4)
     32                                          (#\4 3) (#\3 2) (#\2 1))
     33                                        0))))
     34 
     35 (defparameter *cards-jokering*
     36   (let ((copy (copy-seq *cards*)))
     37     (setf (aref copy (- (char-code #\J) 50)) 0)
     38     copy))
     39 
     40 (declaim (inline card-strength)
     41          (ftype (function (character) fixnum) card-strength))
     42 (defun card-strength (card)
     43   (aref *cards* (- (char-code card) 50)))
     44 
     45 (defparameter *with-jokering* nil)
     46 
     47 (defun hand-strength (hand)
     48   (let* ((groups (group-by (coerce (if *with-jokering*
     49                                        (remove #\J hand)
     50                                        hand)
     51                                    'list)
     52                            :key #'identity
     53                            :value #'identity
     54                            :test #'char=))
     55          (groups (mapcar (lambda (group)
     56                            (declare (type list group))
     57                            (1- (length group)))
     58                          groups))
     59          (groups (sort groups #'>)))
     60     (when *with-jokering*
     61       (let ((n-jokers (count #\J hand)))
     62         (declare (type fixnum n-jokers))
     63         (when (= n-jokers 5)
     64           (return-from hand-strength 70))
     65         (setf groups
     66               (loop for group fixnum in groups
     67                     for missing fixnum = (- 5 group)
     68                     for usable-jokers = (min missing n-jokers)
     69                     when (> missing 0)
     70                       do (incf group usable-jokers)
     71                       and do (decf n-jokers usable-jokers)
     72                     collect group))))
     73     (let* ((n-pairs (count 2 groups))
     74            (highest-sequence (first groups)))
     75       (declare (type fixnum n-pairs highest-sequence))
     76       (cond
     77         ((= highest-sequence 5) 70)
     78         ((= highest-sequence 4) 60)
     79         ((and (= highest-sequence 3)
     80               (= n-pairs 1))
     81          50)
     82         ((= highest-sequence 3) 40)
     83         ((= n-pairs 2) 30)
     84         ((= n-pairs 1) 20)
     85         (t (card-strength (first-elt hand)))))))
     86 
     87 (declaim (ftype (function (simple-string) fixnum) card-strengths))
     88 (defun card-strengths (hand)
     89   (loop with sum-card-strengths fixnum = 0
     90         for card across hand
     91         do (setf sum-card-strengths
     92                  (+ (the fixnum (* sum-card-strengths 20))
     93                     (card-strength card)))
     94         finally (return sum-card-strengths)))
     95 
     96 (defun calculate-strengths (hands-data)
     97   (loop for hand-data of-type hand-data in hands-data
     98         do (setf (hand-data-hand-strength hand-data)
     99                  (hand-strength (hand-data-hand hand-data))
    100 
    101                  (hand-data-cards-strength hand-data)
    102                  (card-strengths (hand-data-hand hand-data)))))
    103 
    104 (defun hand-data< (hand-data-1 hand-data-2)
    105   (let ((strength-1 (hand-data-hand-strength hand-data-1))
    106         (strength-2 (hand-data-hand-strength hand-data-2)))
    107     (if (= strength-1 strength-2)
    108         (progn
    109           (< (hand-data-cards-strength hand-data-1)
    110              (hand-data-cards-strength hand-data-2)))
    111         (< strength-1 strength-2))))
    112 
    113 (declaim (ftype (function (list) fixnum) total-winnings))
    114 (defun total-winnings (hands-data)
    115   (calculate-strengths hands-data)
    116   (let ((hands-data (sort hands-data #'hand-data<)))
    117     (loop for hand-data of-type hand-data in hands-data
    118           for rank fixnum from 1
    119           sum (the fixnum (* (hand-data-bid hand-data) rank)) fixnum)))
    120 
    121 (defmacro with-jokering (() &body body)
    122   `(let ((*cards* *cards-jokering*)
    123          (*with-jokering* t))
    124      ,@body))
    125 
    126 (defun day-7 (input)
    127   (let* ((hands-data-task-1 (parse-input input))
    128          (hands-data-task-2 (copy-seq hands-data-task-1)))
    129     (values (total-winnings hands-data-task-1)
    130             (with-jokering ()
    131               (total-winnings hands-data-task-2)))))