(in-package :ca.mhcat.advent2022)
;; --- Day 5: Supply Stacks ---
;; The expedition can depart as soon as the final supplies
;; have been unloaded from the ships. Supplies are stored in
;; stacks of marked crates, but because the needed supplies
;; are buried under many other crates, the crates need to be
;; rearranged.
;; The ship has a giant cargo crane capable of moving crates
;; between stacks. To ensure none of the crates get crushed
;; or fall over, the crane operator will rearrange them in a
;; series of carefully-planned steps. After the crates are
;; rearranged, the desired crates will be at the top of each
;; stack.
;; The Elves don't want to interrupt the crane operator
;; during this delicate procedure, but they forgot to ask
;; her which crate will end up where, and they want to be
;; ready to unload them as soon as possible so they can
;; embark.
;; They do, however, have a drawing of the starting stacks
;; of crates and the rearrangement procedure (your puzzle
;; input). For example:
;; [D]
;; [N] [C]
;; [Z] [M] [P]
;; 1 2 3
;; move 1 from 2 to 1
;; move 3 from 1 to 3
;; move 2 from 2 to 1
;; move 1 from 1 to 2
;; In this example, there are three stacks of crates. Stack
;; 1 contains two crates: crate Z is on the bottom, and
;; crate N is on top. Stack 2 contains three crates; from
;; bottom to top, they are crates M, C, and D. Finally,
;; stack 3 contains a single crate, P.
;; Then, the rearrangement procedure is given. In each step
;; of the procedure, a quantity of crates is moved from one
;; stack to a different stack. In the first step of the
;; above rearrangement procedure, one crate is moved from
;; stack 2 to stack 1, resulting in this configuration:
;; [D]
;; [N] [C]
;; [Z] [M] [P]
;; 1 2 3
;; In the second step, three crates are moved from stack 1
;; to stack 3. Crates are moved one at a time, so the first
;; crate to be moved (D) ends up below the second and third
;; crates:
;; [Z]
;; [N]
;; [C] [D]
;; [M] [P]
;; 1 2 3
;; Then, both crates are moved from stack 2 to stack 1.
;; Again, because crates are moved one at a time, crate C
;; ends up below crate M:
;; [Z]
;; [N]
;; [M] [D]
;; [C] [P]
;; 1 2 3
;; Finally, one crate is moved from stack 1 to stack 2:
;; [Z]
;; [N]
;; [D]
;; [C] [M] [P]
;; 1 2 3
;; The Elves just need to know which crate will end up on
;; top of each stack; in this example, the top crates are C
;; in stack 1, M in stack 2, and Z in stack 3, so you should
;; combine these together and give the Elves the message
;; CMZ.
;; After the rearrangement procedure completes, what crate
;; ends up on top of each stack?
(defparameter day5/test-data
'(" [D]"
"[N] [C]"
"[Z] [M] [P]"
" 1 2 3"
""
"move 1 from 2 to 1"
"move 3 from 1 to 3"
"move 2 from 2 to 1"
"move 1 from 1 to 2"))
(defun day5/whitespacep (ch)
(or (char= ch #\space)
(char= ch #\tab)
(char= ch #\newline)))
(defun day5/accumulate-tokens (line)
(let ((tokens))
(reduce (lambda (acc ch)
(cond
((not (day5/whitespacep ch)) (cons ch acc))
((null acc) nil)
(t (push acc tokens)
nil)))
;; add a space to trigger the final push
(reverse (cons #\space line))
:initial-value nil)
tokens))
(defun day5/parse-drawing (lines)
(let* ((lines (nreverse lines))
(col-count (length (day5/accumulate-tokens (car lines))))
(pile-lines (mapcar (lambda (line)
(append line (make-sequence
'list (- (* col-count 4)
(length line))
:initial-element #\space)))
(cdr lines))))
(loop for line in pile-lines
collect
(loop for i from 0 below col-count
collect (nth (1+ (* 4 i)) line)))))
(defun day5/partition-input (lines)
(let* ((lines (mapcar (lambda (line)
(coerce line 'list))
lines))
(split-pos (position nil lines)))
(list (subseq lines 0 split-pos)
(subseq lines (1+ split-pos)))))
(defun day5/construct-stacks (drawing)
(let ((lines (day5/parse-drawing drawing)))
(loop for i from 0 below (length (car lines))
collect
(reduce (lambda (acc row)
(let ((ch (nth i row)))
(if (char= #\space ch)
acc
(cons ch acc))))
lines
:initial-value nil))))
(defun day5/parse-instructions (lines)
(loop for line in (mapcar #'day5/accumulate-tokens lines)
collect (mapcar (lambda (idx)
(parse-integer (coerce (nth idx line) 'string)))
'(1 3 5))))
(defun day5/compute-part1 (lines)
(destructuring-bind (drawing instructions) (day5/partition-input lines)
(let ((instructions (day5/parse-instructions instructions))
(stacks (day5/construct-stacks drawing)))
(dolist (task instructions)
(destructuring-bind (n from to) task
(dotimes (i n)
(push (pop (nth (1- from) stacks))
(nth (1- to) stacks)))))
(coerce (mapcar #'car stacks) 'string))))
(defun day5/part1 ()
(day5/compute-part1
(load-lines "day5.txt")))
;; --- Part Two ---
;; As you watch the crane operator expertly rearrange the
;; crates, you notice the process isn't following your
;; prediction.
;; Some mud was covering the writing on the side of the
;; crane, and you quickly wipe it away. The crane isn't a
;; CrateMover 9000 - it's a CrateMover 9001.
;; The CrateMover 9001 is notable for many new and exciting
;; features: air conditioning, leather seats, an extra cup
;; holder, and the ability to pick up and move multiple
;; crates at once.
;; Again considering the example above, the crates begin in
;; the same configuration:
;; [D]
;; [N] [C]
;; [Z] [M] [P]
;; 1 2 3
;; Moving a single crate from stack 2 to stack 1 behaves the
;; same as before:
;; [D]
;; [N] [C]
;; [Z] [M] [P]
;; 1 2 3
;; However, the action of moving three crates from stack 1
;; to stack 3 means that those three moved crates stay in
;; the same order, resulting in this new configuration:
;; [D]
;; [N]
;; [C] [Z]
;; [M] [P]
;; 1 2 3
;; Next, as both crates are moved from stack 2 to stack 1,
;; they retain their order as well:
;; [D]
;; [N]
;; [C] [Z]
;; [M] [P]
;; 1 2 3
;; Finally, a single crate is still moved from stack 1 to
;; stack 2, but now it's crate C that gets moved:
;; [D]
;; [N]
;; [Z]
;; [M] [C] [P]
;; 1 2 3
;; In this example, the CrateMover 9001 has put the crates
;; in a totally different order: MCD.
;; Before the rearrangement process finishes, update your
;; simulation so that the Elves know where they should stand
;; to be ready to unload the final supplies. After the
;; rearrangement procedure completes, what crate ends up on
;; top of each stack?
(defun day5/compute-part2 (lines)
(destructuring-bind (drawing instructions) (day5/partition-input lines)
(let ((instructions (day5/parse-instructions instructions))
(stacks (day5/construct-stacks drawing)))
(dolist (task instructions)
(destructuring-bind (n from to) task
(macrolet ((src () '(nth (1- from) stacks))
(dst () '(nth (1- to) stacks)))
(setf (dst) (append (subseq (src) 0 n) (dst))
(src) (subseq (src) n)))))
(coerce (mapcar #'car stacks) 'string))))
(defun day5/part2 ()
(day5/compute-part2
(load-lines "day5.txt")))