diff options
| -rw-r--r-- | 2022/puzzle-5.lisp | 148 |
1 files changed, 148 insertions, 0 deletions
diff --git a/2022/puzzle-5.lisp b/2022/puzzle-5.lisp new file mode 100644 index 0000000..09be798 --- /dev/null +++ b/2022/puzzle-5.lisp @@ -0,0 +1,148 @@ +(defvar input (uiop:read-file-string "2022/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) + until (null line) + collect + ;; Parse each instruction then move the crates! + (destructuring-bind (n a b) (parse-instruction-str line) + (move-crates n a b))))) + +(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))) |