aoc2021 day8

aoc2021-day8.lisp

;;;; +----------------------------------------------------------------+
;;;; | Advent of Code 2021                                            |
;;;; +----------------------------------------------------------------+

(defpackage #:snippets/aoc2021/day8
  (:use #:cl #:screamer)
  (:shadowing-import-from #:screamer #:defun #:multiple-value-bind #:y-or-n-p)
  (:export
   #:day8))

(in-package #:snippets/aoc2021/day8)

(defun entry-shuffled-wirings (entry)
  (subseq entry 0 10))

(defun entry-output-wirings (entry)
  (subseq entry 11))

(defun easy-wiring-p (wiring)
  (member (length wiring) '(2 3 4 7)))

(defun count-easy-output-digits (entry)
  (count-if #'easy-wiring-p (entry-output-wirings entry)))

(defun sum-easy-output-digit-counts (entries)
  (reduce #'+ entries :key #'count-easy-output-digits))

(defun preprocess-wirings (wirings-as-strings)
  (mapcar (lambda (string)
            (coerce string 'list))
          wirings-as-strings))

(defun canonical-wiring (wiring)
  (sort (copy-seq wiring) #'char<))

(defun postprocess-wirings (wirings-as-lists)
  (mapcar (lambda (list)
            (canonical-wiring (coerce list 'string)))
          wirings-as-lists))

(defun keep-if-same-length (sequence sequences)
  (remove (length sequence) sequences :key #'length :test-not #'=))

(defun create-ordering-variables (reference shuffled)
  (mapcar (lambda (wiring)
            (a-member-ofv (keep-if-same-length wiring shuffled)))
          reference))

(defun all1 (x xs function)
  (if (null xs)
      t
      (andv (funcall function x (first xs))
            (all1 x (rest xs) function)
            (all1 (first xs) (rest xs) function))))

(defun differentv (x y)
  (notv (equalv x y)))

(defun all-differentv (list)
  (all1 (first list) (rest list) #'differentv))

(defun all2 (x xs y ys function)
  (if (null xs)
      t
      (andv (funcall function x (first xs) y (first ys))
            (all2 x (rest xs) y (rest ys) function)
            (all2 (first xs) (rest xs) (first ys) (rest ys) function))))

(defun num-shared-segments (w1 w2)
  (length (intersection w1 w2)))

(defun same-num-shared-segmentsv (w1 w2 v1 v2)
  (=v (num-shared-segments w1 w2)
      (funcallv #'num-shared-segments v1 v2)))

(defun all-same-num-shared-segmentsv (reference ordering)
  (all2 (first reference) (rest reference)
        (first ordering) (rest ordering)
        #'same-num-shared-segmentsv))

(defvar *ordered-wirings*
  (preprocess-wirings
   '("abcefg" "cf" "acdeg" "acdfg" "bcdf"
     "abdfg" "abdefg" "acf" "abcdefg" "abcdfg")))

(defun create-ordering (shuffled-wirings)
  (let ((ordering (create-ordering-variables *ordered-wirings* shuffled-wirings)))
    (assert! (all-differentv ordering))
    (assert! (all-same-num-shared-segmentsv *ordered-wirings* ordering))
    ordering))

(defun solve-ordering (shuffled-wirings)
  (postprocess-wirings
   (one-value
       (solution (create-ordering (preprocess-wirings shuffled-wirings))
                 (static-ordering #'linear-force)))))

(defun add-decimal-digit (number digit)
  (+ (* number 10) digit))

(defun make-number (digits)
  (reduce #'add-decimal-digit digits :initial-value 0))

(defun decode-digit (wiring ordering)
  (position (canonical-wiring wiring) ordering :test #'equal))

(defun decode-digits (wirings ordering)
  (mapcar (lambda (wiring)
            (decode-digit wiring ordering))
          wirings))

(defun decode-entry (entry)
  (make-number
   (decode-digits (entry-output-wirings entry)
                  (solve-ordering (entry-shuffled-wirings entry)))))

(defun sum-output-values (entries)
  (reduce #'+ entries :key #'decode-entry))

(defun day8 (input)
  (list (sum-easy-output-digit-counts input)
        (sum-output-values input)))