aoc2020 day21

aoc2020-day21.lisp

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

(defpackage #:snippets/aoc2020/day21
  (:use #:cl)
  (:import-from
   #:alexandria
   #:make-keyword)
  (:import-from
   #:split-sequence
   #:split-sequence-if)
  (:shadowing-import-from
   #:screamer
   #:defun
   #:make-variable
   #:assert!
   #:memberv
   #:solution
   #:static-ordering
   #:linear-force
   #:one-value
   #:value-of
   #:notv
   #:equalv)
  (:export
   #:day21))

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

(defstruct food
  ingredients
  allergens)

(defun parse (input)
  (mapcar #'parse-food input))

(defun parse-food (string)
  (let* ((tokens (split-sequence-if (lambda (char) (find char " (),"))
                                    string
                                    :remove-empty-subseqs t))
         (symbols (mapcar (lambda (token)
                            (make-keyword (string-upcase token)))
                          tokens))
         (contains (member :contains symbols))
         (ingredients (ldiff symbols contains))
         (allergens (rest contains)))
    (make-food :ingredients ingredients
               :allergens allergens)))

(defun union-of (function list)
  (reduce (lambda (set item)
            (union set (funcall function item)))
          list
          :initial-value '()))

(defun list-ingredients (foods)
  (union-of #'food-ingredients foods))

(defun list-allergens (foods)
  (union-of #'food-allergens foods))

(defun create-assignment (foods)
  (let* ((allergens (list-allergens foods))
         (variables (mapcar #'make-variable allergens)))
    (assert!-all-different variables)
    (mapcar #'cons allergens variables)))

(defun allergen-variable (assignment allergen)
  (cdr (assoc allergen assignment)))

(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 assign-ingredients-to-allergens (assignment foods)
  (dolist (food foods)
    (let ((ingredients (food-ingredients food)))
      (dolist (allergen (food-allergens food))
        (assert! (memberv (allergen-variable assignment allergen) ingredients))))))

(defun find-dangerous-ingredients (foods)
  (let ((assignment (create-assignment foods)))
    (assign-ingredients-to-allergens assignment foods)
    (solution assignment (static-ordering #'linear-force))))

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

(defun count-inert-ingredients (foods assignment)
  (let* ((all (list-ingredients foods))
         (dangerous (mapcar #'cdr assignment))
         (inert (set-difference all dangerous)))
    (sum foods
         :key (lambda (food)
                (length (intersection (food-ingredients food) inert))))))

(defun canonical-dangerous-ingredients (assignment)
  (format nil "~(~{~A~^,~}~)"
          (mapcar #'cdr (sort assignment #'string< :key #'car))))

(defun day21 (input)
  (let* ((foods (parse input))
         (assignment (one-value (find-dangerous-ingredients foods))))
    (list (count-inert-ingredients foods assignment)
          (canonical-dangerous-ingredients assignment))))