aoc2020 day16

aoc2020-day16.lisp

;;;; +----------------------------------------------------------------+
;;;; | Advent of Code 2020                                            |
;;;; +----------------------------------------------------------------+

(defpackage #:snippets/aoc2020/day16
  (:use #:cl)
  (:import-from
   #:split-sequence
   #:split-sequence
   #:split-sequence-if)
  (:import-from
   #:alexandria
   #:iota
   #:starts-with-subseq)
  (:shadowing-import-from
   #:screamer
   #:defun
   #:one-value
   #:make-variable
   #:assert!
   #:notv
   #:equalv
   #:memberv
   #:solution
   #:reorder
   #:domain-size
   #:linear-force)
  (:export
   #:day16))

(in-package #:snippets/aoc2020/day16)

(defstruct schema
  fields)

(defstruct field
  name
  ranges)

(defun parse (input)
  (destructuring-bind (spec my nearby) input
    (values (parse-schema spec)
            (parse-ticket (second my))
            (mapcar #'parse-ticket (rest nearby)))))

(defun parse-schema (strings)
  (make-schema :fields (mapcar #'parse-field strings)))

(defun parse-field (string)
  (let* ((colon (position #\: string))
         (name (subseq string 0 colon))
         (tokens (split-sequence-if (lambda (char) (find char " -"))
                                    string
                                    :start (1+ colon)
                                    :remove-empty-subseqs t)))
    (setf tokens (remove "or" tokens :test #'equal))
    (make-field :name name
                :ranges (make-ranges (mapcar #'parse-integer tokens)))))

(defun make-ranges (numbers)
  (loop for (a b) on numbers by #'cddr collect (list a b)))

(defun parse-ticket (string)
  (map 'vector #'parse-integer (split-sequence #\, string)))

(defmethod valid-value-p (value (schema schema))
  (some (lambda (field) (valid-value-p value field))
        (schema-fields schema)))

(defmethod valid-value-p (value (field field))
  (loop for (low high) in (field-ranges field)
        thereis (<= low value high)))

(defun invalid-values (ticket schema)
  (remove-if (lambda (value) (valid-value-p value schema)) ticket))

(defun sum (sequence &key (key #'identity))
  (reduce #'+ sequence :key key))

(defun ticket-scanning-error-rate (tickets schema)
  (sum tickets :key (lambda (ticket) (sum (invalid-values ticket schema)))))

(defun valid-ticket-p (ticket schema)
  (every (lambda (value) (valid-value-p value schema)) ticket))

(defun valid-tickets (tickets schema)
  (loop for ticket in tickets
        when (valid-ticket-p ticket schema)
        collect ticket))

(defun assert!-all-different (variables)
  (do ((sublist variables (rest sublist)))
      ((null sublist))
    (let ((a (first sublist)))
      (dolist (b (rest sublist))
        (assert! (notv (equalv a b)))))))

(defun consistent-fields (values fields)
  (loop for field in fields
        when (every (lambda (value) (valid-value-p value field)) values)
        collect field))

(defun values-in-position (tickets position)
  (mapcar (lambda (ticket) (aref ticket position)) tickets))

(defun fields-in-order (tickets schema)
  (let* ((fields (schema-fields schema))
         (n (length fields))
         (variables (loop repeat n collect (make-variable))))
    (assert!-all-different variables)
    (mapc (lambda (variable position)
            (let* ((values (values-in-position tickets position))
                   (consistent (consistent-fields values fields)))
              (assert! (memberv variable consistent))))
          variables
          (iota n))
    (solution variables
              (reorder #'domain-size
                       (constantly nil)
                       #'<
                       #'linear-force))))

(defun extract-values (ticket fields prefix)
  (loop for field in fields
        for value across ticket
        when (starts-with-subseq prefix (field-name field))
        collect value))

(defun product (sequence)
  (reduce #'* sequence))

(defun day16 (input)
  (multiple-value-bind (schema my nearby)
      (parse input)
    (list (ticket-scanning-error-rate nearby schema)
          (let* ((valid (valid-tickets nearby schema))
                 (fields (one-value (fields-in-order valid schema))))
            (product (extract-values my fields "departure"))))))