(defpackage #:advent.2024.05
  (:use #:cl #:advent.2024.00))
(in-package #:advent.2024.05)

;;; Part 1.
;; Add the center numbers of each valid sequence.
;; Valid sequences (the second part of the input) are those which violate none
;; of the order rules in the first part of the input.
;; An order rule is <NN>|<MM>, where <NN> must come before <MM> at some point in
;; the sequence.

(defun parse-rule (line)
  (destructuring-bind (a b) (ppcre:split "\\|" line)
    (cons (parse-integer a) (parse-integer b))))

(defun parse-sequence (line)
  (mapcar #'parse-integer (ppcre:split "," line)))

(defun parse-file (file)
  "Parse FILE and return 2 values: an alist of order rules and a list of print
sequences."
  (let* (rules seqs)
    (loop with bucket = 'rules
          for line in (uiop:read-file-lines file)
          if (uiop:emptyp line)
            do (setq bucket 'seqs)
          else
            do (if (eq 'rules bucket)
                   (push (parse-rule line) rules)
                   (push (parse-sequence line) seqs)))
    (values (nreverse rules)
            (nreverse seqs))))

(defun check1 (rule seq)
  "Make sure SEQ follows RULE."
  (let ((rest (member (car rule) seq)))
    (or (not rest)
        (member (cdr rule) rest)
        (not (member (cdr rule) seq)))))

(defun check (rules seq)
  "Make sure SEQ follows every RULE."
  (every (lambda (r)
           (check1 r seq)) rules))

(defun median-value (list)
  (let ((half-length (- (/ (length list) 2) 0.5)))
    (/ (+ (nth (floor half-length) list)
          (nth (ceiling half-length) list))
       2)))

(defun get-sublist (input fn)
  (multiple-value-bind (rules seqs) (parse-file input)
    (funcall fn (lambda (s) (check rules s)) seqs)))

(defun get-valids (&optional (input (input)))
  (get-sublist input #'remove-if-not))

(defun get-invalids (&optional (input (input)))
  (get-sublist input #'remove-if))

(defun solve1 (&optional (input (input)))
  (apply #'+ (mapcar #'median-value (get-valids input))))

;;; Part 2.
;; Correct the incorrected update sequences with the rules.

;;; BIG HUGELY shoutout to elly, for helping me realize this was basically
;;; `sort' :D

(defun get-rules (&optional (in (input)))
  (multiple-value-bind (rs ss) (parse-file in)
    (declare (ignorable ss))
    rs))

(defun fails (seq rules)
  (loop for r in rules
        unless (check1 r seq)
          collect r))

(defun swap (list a b &rest position-args)
  "Swap A and B in LIST."
  (let ((pos-a (apply #'position a list position-args))
        (pos-b (apply #'position b list position-args)))
    (when (and pos-a pos-b)
      (loop for e in list
            for i from 0
            collect (cond
                      ((= i pos-a) b)
                      ((= i pos-b) a)
                      (t e))))))

(defun correct (seq rules)
  (stable-sort (copy-seq seq)
               (lambda (a b)
                 (not (find (cons a b) rules :test #'equal)))))

(defun solve2 (&optional (input (input)))
  (let ((invalids (get-invalids input))
        (rules (get-rules input)))
    (apply #'+ (mapcar (lambda (s)
                         (median-value (correct s rules)))
                       invalids))))