1(defpackage #:advent.2024.05
2 (:use #:cl #:advent.2024.00))
3(in-package #:advent.2024.05)
4
5;;; Part 1.
6;; Add the center numbers of each valid sequence.
7;; Valid sequences (the second part of the input) are those which violate none
8;; of the order rules in the first part of the input.
9;; An order rule is <NN>|<MM>, where <NN> must come before <MM> at some point in
10;; the sequence.
11
12(defun parse-rule (line)
13 (destructuring-bind (a b) (ppcre:split "\\|" line)
14 (cons (parse-integer a) (parse-integer b))))
15
16(defun parse-sequence (line)
17 (mapcar #'parse-integer (ppcre:split "," line)))
18
19(defun parse-file (file)
20 "Parse FILE and return 2 values: an alist of order rules and a list of print
21sequences."
22 (let* (rules seqs)
23 (loop with bucket = 'rules
24 for line in (uiop:read-file-lines file)
25 if (uiop:emptyp line)
26 do (setq bucket 'seqs)
27 else
28 do (if (eq 'rules bucket)
29 (push (parse-rule line) rules)
30 (push (parse-sequence line) seqs)))
31 (values (nreverse rules)
32 (nreverse seqs))))
33
34(defun check1 (rule seq)
35 "Make sure SEQ follows RULE."
36 (let ((rest (member (car rule) seq)))
37 (or (not rest)
38 (member (cdr rule) rest)
39 (not (member (cdr rule) seq)))))
40
41(defun check (rules seq)
42 "Make sure SEQ follows every RULE."
43 (every (lambda (r)
44 (check1 r seq)) rules))
45
46(defun median-value (list)
47 (let ((half-length (- (/ (length list) 2) 0.5)))
48 (/ (+ (nth (floor half-length) list)
49 (nth (ceiling half-length) list))
50 2)))
51
52(defun get-sublist (input fn)
53 (multiple-value-bind (rules seqs) (parse-file input)
54 (funcall fn (lambda (s) (check rules s)) seqs)))
55
56(defun get-valids (&optional (input (input)))
57 (get-sublist input #'remove-if-not))
58
59(defun get-invalids (&optional (input (input)))
60 (get-sublist input #'remove-if))
61
62(defun solve1 (&optional (input (input)))
63 (apply #'+ (mapcar #'median-value (get-valids input))))
64
65;;; Part 2.
66;; Correct the incorrected update sequences with the rules.
67
68;;; BIG HUGELY shoutout to elly, for helping me realize this was basically
69;;; `sort' :D
70
71(defun get-rules (&optional (in (input)))
72 (multiple-value-bind (rs ss) (parse-file in)
73 (declare (ignorable ss))
74 rs))
75
76(defun fails (seq rules)
77 (loop for r in rules
78 unless (check1 r seq)
79 collect r))
80
81(defun swap (list a b &rest position-args)
82 "Swap A and B in LIST."
83 (let ((pos-a (apply #'position a list position-args))
84 (pos-b (apply #'position b list position-args)))
85 (when (and pos-a pos-b)
86 (loop for e in list
87 for i from 0
88 collect (cond
89 ((= i pos-a) b)
90 ((= i pos-b) a)
91 (t e))))))
92
93(defun correct (seq rules)
94 (stable-sort (copy-seq seq)
95 (lambda (a b)
96 (not (find (cons a b) rules :test #'equal)))))
97
98(defun solve2 (&optional (input (input)))
99 (let ((invalids (get-invalids input))
100 (rules (get-rules input)))
101 (apply #'+ (mapcar (lambda (s)
102 (median-value (correct s rules)))
103 invalids))))
104