151 lines
4.8 KiB
Common Lisp
151 lines
4.8 KiB
Common Lisp
(defvar input (uiop:read-file-string "5-input"))
|
|
|
|
|
|
;; When we get two newlines, it means the end of the initial state and
|
|
;; the start of instructions
|
|
(defvar parse-separator (search (format nil "~%~%") input))
|
|
(defvar initial-state
|
|
(with-input-from-string (s (subseq input 0 parse-separator))
|
|
(loop
|
|
for line = (read-line s nil)
|
|
until (null line)
|
|
collect line)))
|
|
|
|
;; the last number, indicating the number of stacks
|
|
(defparameter n-stacks (let ((str (car (last initial-state))))
|
|
(parse-integer (subseq str (- (length str) 1)))))
|
|
|
|
(defun default-state ()
|
|
(loop for i from 1 to n-stacks
|
|
collect nil))
|
|
|
|
(defvar state
|
|
(default-state))
|
|
|
|
#|
|
|
conjecture: the nth stack, if it has an entry, has '[' beginning at index 4n;
|
|
|
|
base case: the 0th stack must begin at index 0 (if at all)
|
|
|
|
intuition: next stack must start at 0 + 2 (for the stack info) +
|
|
1 (for whitespace) + 1 so 4.
|
|
|
|
inductive hypothesis: for the kth stack [ begins at 4k
|
|
|
|
proof of induction claim: from 4k we have the following:
|
|
4k+1: symbol
|
|
4k+2: ]
|
|
4k+3: whitespace
|
|
4k+4: data for the (k+1 stack)
|
|
|
|
Immediately 4k+4 = 4(k+1) so by principle of induction we have the
|
|
conjecture. QED.
|
|
|
|
This gives us all the information we need to make a parser: check
|
|
every position and see if it has a [ char. If so then parse the data
|
|
and insert into the index/4th stack!|#
|
|
|
|
(defun parse-initial-state ()
|
|
(loop
|
|
;; don't want to parse the last line
|
|
for j in (remove (car (last initial-state)) initial-state)
|
|
do
|
|
(loop
|
|
for i from 0
|
|
for c across j
|
|
do
|
|
(if (char= c #\[)
|
|
(let ((ind (/ i 4))
|
|
(sym (subseq j (+ i 1) (+ i 2))))
|
|
(setf (nth ind state) (append (nth ind state) (list sym))))))))
|
|
|
|
|
|
;; Now we have the initial memory layout, we need to parse program code.
|
|
|
|
;; + 2 because two newlines
|
|
(defvar instructions-str (subseq input (+ 2 parse-separator)))
|
|
|
|
#| Each command is of the following: move ~n from ~a to ~b.
|
|
|
|
~n is some natural number of crates, ~a is the stack from which we
|
|
are taking them and ~b is the stack we are adding them to. Let's
|
|
define this operation first! |#
|
|
|
|
(defun move-crates (n a b)
|
|
"Take N number of crates from stack at position A to stack at position B"
|
|
(let ((stack-a (nth a state))
|
|
(stack-b (nth b state)))
|
|
(if (= n 0)
|
|
nil
|
|
(progn
|
|
;; Pop the first element off the stack
|
|
(setf (nth a state) (cdr stack-a))
|
|
;; Then cons that onto b
|
|
(setf (nth b state) (cons (car stack-a) stack-b))
|
|
;; Recur
|
|
(move-crates (- n 1) a b)))))
|
|
|
|
(defun parse-instruction-str (instruction)
|
|
"Given INSTRUCTION of form \"move n from a to b\", return (n (a - 1) (b - 1))"
|
|
(let ((first (search "move " instruction))
|
|
(second (search "from " instruction))
|
|
(third (search "to " instruction)))
|
|
(list
|
|
(parse-integer (subseq instruction (+ 5 first) (- second 1)))
|
|
;; Input assumes crates start at 1, but we need it to start at 0
|
|
(- (parse-integer (subseq instruction (+ 5 second) (- third 1))) 1)
|
|
(- (parse-integer (subseq instruction (+ 3 third))) 1))))
|
|
|
|
(defun perform-instructions (instructions)
|
|
(with-input-from-string (s instructions)
|
|
(loop
|
|
for line = (read-line s nil)
|
|
while line
|
|
collect
|
|
;; Parse each instruction then move the crates!
|
|
(destructuring-bind (n a b) (parse-instruction-str line)
|
|
(move-crates n a b)))))
|
|
|
|
;; The answer is simply the first top of each stack
|
|
(defun first-round ()
|
|
(setq state (default-state))
|
|
(parse-initial-state)
|
|
(perform-instructions instructions-str)
|
|
(let ((ret (mapcar #'car state)))
|
|
(setq state (default-state))
|
|
(reduce (lambda (s1 s2) (concatenate 'string s1 s2)) ret)))
|
|
|
|
;; Round 2 is pretty simple: the move-crates algorithm is overhauled
|
|
;; to keep movements "in-order". Thankfully I already implemented
|
|
;; this by accident when implementing move-crates, so easy!
|
|
|
|
(defun move-crates-2 (n a b)
|
|
(let ((stack-a (nth a state))
|
|
(stack-b (nth b state)))
|
|
(setf (nth b state)
|
|
(append (loop for i from 1 to n
|
|
for j in stack-a
|
|
collect j)
|
|
stack-b))
|
|
(dotimes (i n)
|
|
(setf stack-a (cdr stack-a)))
|
|
(setf (nth a state) stack-a)))
|
|
|
|
(defun perform-instructions-2 (instructions)
|
|
(with-input-from-string (s instructions)
|
|
(loop
|
|
for line = (read-line s nil)
|
|
until (null line)
|
|
collect
|
|
;; Parse each instruction then move the crates!
|
|
(destructuring-bind (n a b) (parse-instruction-str line)
|
|
(move-crates-2 n a b)))))
|
|
|
|
(defun second-round ()
|
|
(setq state (default-state))
|
|
(parse-initial-state)
|
|
(perform-instructions-2 instructions-str)
|
|
(let ((ret (mapcar #'car state)))
|
|
(setq state (default-state))
|
|
(reduce (lambda (s1 s2) (concatenate 'string s1 s2)) ret)))
|