aoc2021 day18

aoc2021-day18.lisp

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

(defpackage #:snippets/aoc2021/day18
  (:use #:cl)
  (:import-from
   #:alexandria)
  (:export
   #:day18))

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

(defun num (string start)
  (parse-integer string :start start :junk-allowed t))

(defun cat (&rest strings)
  (apply #'concatenate 'string strings))

(defun s-scan (number)
  (let ((depth 0)
        (regular-number 0)
        (split nil)
        (digit 0))
    (dotimes (i (length number))
      (let ((char (char number i)))
        (cond ((char= char #\[)
               (when (= 4 depth)
                 (return-from s-scan (values :explode i)))
               (incf depth))
              ((char= char #\])
               (decf depth)
               (setf regular-number 0))
              ((setf digit (digit-char-p char))
               (setf regular-number (+ (* regular-number 10) digit))
               (when (and (>= regular-number 10) (null split))
                 (setf split (list :split (1- i) regular-number))))
              ((char= char #\,)
               (setf regular-number 0))
              (t
               (error "Unexpected char ~S." char)))))
    (if split
        (values-list split)
        :done)))

(defun explode-left-part (number pos e1)
  (let* ((left-digit-pos
           (position-if #'digit-char-p number :end pos :from-end t))
         (left-num-end-pos
           (and left-digit-pos
                (1+ left-digit-pos)))
         (left-num-pos
           (and left-digit-pos
                (1+
                 (or (position-if-not #'digit-char-p number :end left-digit-pos :from-end t)
                     (1- left-digit-pos)))))
         (left-num
           (and left-num-pos (num number left-num-pos))))
    (if (null left-num)
        (subseq number 0 pos)
        (cat (subseq number 0 left-num-pos)
             (princ-to-string (+ left-num e1))
             (subseq number left-num-end-pos pos)))))

(defun explode-right-part (number end-pos e2)
  (let* ((right-num-pos
           (position-if #'digit-char-p number :start end-pos))
         (right-num-end-pos
           (and right-num-pos
                (position-if-not #'digit-char-p number :start right-num-pos)))
         (right-num
           (and right-num-pos (num number right-num-pos))))
    (if (null right-num)
        (subseq number end-pos)
        (cat (subseq number end-pos right-num-pos)
             (princ-to-string (+ right-num e2))
             (subseq number right-num-end-pos)))))

(defun s-explode (number pos)
  (let* ((end-pos (1+ (position #\] number :start pos)))
         (e1 (num number (1+ pos)))
         (comma-pos (position #\, number :start pos))
         (e2 (num number (1+ comma-pos))))
    (cat (explode-left-part number pos e1)
         "0"
         (explode-right-part number end-pos e2))))

(defun s-split (number pos n)
  (cat (subseq number 0 pos)
       (format nil "[~D,~D]" (truncate n 2) (ceiling n 2))
       (subseq number (+ pos 2))))

(defun s-reduce-1 (number)
  (multiple-value-bind (action pos n)
      (s-scan number)
    (ecase action
      (:explode
       (s-explode number pos))
      (:split
       (s-split number pos n))
      (:done
       number))))

(defun s-reduce (number)
  (loop for before = number then after
        for after = (s-reduce-1 before)
        until (equal before after)
        finally (return after)))

(defun s-add (number1 number2)
  (s-reduce (format nil "[~A,~A]" number1 number2)))

(defun s-sum (numbers)
  (reduce #'s-add numbers))

(defun s-read (number)
  (read-from-string
   (with-output-to-string (out)
     (with-input-from-string (in number)
       (loop for char = (read-char in nil nil)
             until (null char)
             do (case char
                  (#\, (write-string " . " out))
                  (#\[ (write-char #\( out))
                  (#\] (write-char #\) out))
                  (t (write-char char out))))))))

(defun magnitude (tree)
  (if (integerp tree)
      tree
      (+ (* 3 (magnitude (car tree)))
         (* 2 (magnitude (cdr tree))))))

(defun largest-pairwise-magnitude (numbers)
  (let ((largest 0))
    (alexandria:map-permutations
     (lambda (pair-of-numbers)
       (alexandria:maxf largest (magnitude (s-read (s-sum pair-of-numbers)))))
     numbers
     :length 2
     :copy nil)
    largest))

(defun day18 (input)
  (list (magnitude (s-read (s-sum input)))
        (largest-pairwise-magnitude input)))

;; Some tests

(defun expect-reduce-1 (input expected)
  (let ((actual (s-reduce-1 input)))
    (assert (equal actual expected))))

(defun test-reduce-1 ()
  (expect-reduce-1 "[[[[[9,8],1],2],3],4]" "[[[[0,9],2],3],4]")
  (expect-reduce-1 "[7,[6,[5,[4,[3,2]]]]]" "[7,[6,[5,[7,0]]]]")
  (expect-reduce-1 "[[6,[5,[4,[3,2]]]],1]" "[[6,[5,[7,0]]],3]")
  (expect-reduce-1 "[[3,[2,[1,[7,3]]]],[6,[5,[4,[3,2]]]]]" "[[3,[2,[8,0]]],[9,[5,[4,[3,2]]]]]")
  (expect-reduce-1 "[[3,[2,[8,0]]],[9,[5,[4,[3,2]]]]]" "[[3,[2,[8,0]]],[9,[5,[7,0]]]]"))

(defun expect-sum (inputs expected)
  (let ((actual (s-sum inputs)))
    (assert (equal actual expected))))

(defun test-sum ()
  (expect-sum '("[[[[4,3],4],4],[7,[[8,4],9]]]" "[1,1]")
              "[[[[0,7],4],[[7,8],[6,0]]],[8,1]]")
  (expect-sum '("[1,1]" "[2,2]" "[3,3]" "[4,4]")
              "[[[[1,1],[2,2]],[3,3]],[4,4]]")
  (expect-sum '("[1,1]" "[2,2]" "[3,3]" "[4,4]" "[5,5]")
              "[[[[3,0],[5,3]],[4,4]],[5,5]]")
  (expect-sum '("[1,1]" "[2,2]" "[3,3]" "[4,4]" "[5,5]" "[6,6]")
              "[[[[5,0],[7,4]],[5,5]],[6,6]]")
  (expect-sum '("[[[0,[4,5]],[0,0]],[[[4,5],[2,6]],[9,5]]]"
                "[7,[[[3,7],[4,3]],[[6,3],[8,8]]]]"
                "[[2,[[0,8],[3,4]]],[[[6,7],1],[7,[1,6]]]]"
                "[[[[2,4],7],[6,[0,5]]],[[[6,8],[2,8]],[[2,1],[4,5]]]]"
                "[7,[5,[[3,8],[1,4]]]]"
                "[[2,[2,2]],[8,[8,1]]]"
                "[2,9]"
                "[1,[[[9,3],9],[[9,0],[0,7]]]]"
                "[[[5,[7,4]],7],1]"
                "[[[[4,2],2],6],[8,7]]")
              "[[[[8,7],[7,7]],[[8,6],[7,7]]],[[[0,7],[6,6]],[8,7]]]"))