From 93b8ae46207cf29660fb3c21d34dc45ee872c670 Mon Sep 17 00:00:00 2001 From: Aryadev Chavali Date: Thu, 13 Jul 2023 15:33:49 +0100 Subject: (2022)-deleted puzzle files I think I did this by accident, check out https://git.aryadevchavali.com/advent-of-code/ for my actual advent of code runs. --- 2022/puzzle-5.lisp | 148 ----------------------------------------------------- 1 file changed, 148 deletions(-) delete mode 100644 2022/puzzle-5.lisp (limited to '2022/puzzle-5.lisp') diff --git a/2022/puzzle-5.lisp b/2022/puzzle-5.lisp deleted file mode 100644 index 09be798..0000000 --- a/2022/puzzle-5.lisp +++ /dev/null @@ -1,148 +0,0 @@ -(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))) -- cgit v1.2.3-13-gbd6f