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-1.lisp | 26 ---------- 2022/puzzle-2.lisp | 54 ------------------- 2022/puzzle-3.lisp | 67 ------------------------ 2022/puzzle-4.lisp | 59 --------------------- 2022/puzzle-5.lisp | 148 ----------------------------------------------------- 5 files changed, 354 deletions(-) delete mode 100644 2022/puzzle-1.lisp delete mode 100644 2022/puzzle-2.lisp delete mode 100644 2022/puzzle-3.lisp delete mode 100644 2022/puzzle-4.lisp delete mode 100644 2022/puzzle-5.lisp (limited to '2022') diff --git a/2022/puzzle-1.lisp b/2022/puzzle-1.lisp deleted file mode 100644 index 3a1510e..0000000 --- a/2022/puzzle-1.lisp +++ /dev/null @@ -1,26 +0,0 @@ -(defvar input (uiop:read-file-string "2022/1-input")) -(defvar *sep (format nil "~%~%")) - -(defun get-lists (input) - (let ((pos (search *sep input))) - (with-input-from-string (s (subseq input 0 pos)) - (let ((converted - (loop - for line = (read-line s nil nil) - while line - collect (parse-integer line)))) - (if (null pos) - (list converted) - (cons converted - (get-lists (subseq input (+ pos 2))))))))) - -(defvar sums (sort (mapcar (lambda (lst) (reduce #'+ lst)) (get-lists input)) #'>)) - -;; First challenge -(format t "Top snacks: ~a" (car sums)) - -;; Second challenge -(let ((first (car sums)) - (second (car (cdr sums))) - (third (car (cdr (cdr sums))))) - (format t "~a,~a,~a:>~a" first second third (+ first second third))) diff --git a/2022/puzzle-2.lisp b/2022/puzzle-2.lisp deleted file mode 100644 index b3b0155..0000000 --- a/2022/puzzle-2.lisp +++ /dev/null @@ -1,54 +0,0 @@ -(defvar input (uiop:read-file-string "2022/2-input")) -;; Each newline represents a new round, which we should parse on the go - -(defun sensible-convert-input (str) - (cond - ((or (string= str "X") (string= str "A")) 0) - ((or (string= str "Y") (string= str "B")) 1) - ((or (string= str "Z") (string= str "C")) 2))) - -;; Round 1 -(defvar rounds - (with-input-from-string (stream input) - (loop - for strategy = (read-line stream nil) - until (null strategy) - collect - (let ((opponent (subseq strategy 0 1)) - (yours (subseq strategy 2 3))) - (list (sensible-convert-input opponent) (sensible-convert-input yours)))))) - -(loop - for round in rounds - until (null round) - sum - (destructuring-bind (opp you) round - (+ - 1 you ;; base score - (cond ; outcome score - ((eq you opp) 3) - ((eq (mod (+ 1 opp) 3) you) 6) - (t 0))))) - -;; Round 2. - -;; We can still use the same rounds data as previously, just -;; reinterpret it in when doing the sum. - -(defun get-correct-choice (opponent outcome) - (case outcome - (0 (mod (- opponent 1) 3)) - (1 opp) - (2 (mod (+ 1 opponent) 3)) - (t 0))) - -(loop for round in rounds - sum - (destructuring-bind (opp you) round - (let ((choice (get-correct-choice opp you))) - (+ 1 choice - (case you ;; outcome -> score - (0 0) - (1 3) - (2 6) - (t 0)))))) diff --git a/2022/puzzle-3.lisp b/2022/puzzle-3.lisp deleted file mode 100644 index c5ee3d3..0000000 --- a/2022/puzzle-3.lisp +++ /dev/null @@ -1,67 +0,0 @@ -(defvar input (uiop:read-file-string "2022/3-input")) - -(defun split-string-in-two (s) - (let ((len (length s))) - (list (subseq s 0 (/ len 2)) (subseq s (/ len 2))))) - -(defvar inputs (with-input-from-string (s input) - (loop - for line = (read-line s nil) - until (null line) - collect (split-string-in-two line)))) - -(defun string-to-clist (str) - (loop for char across str collect char)) - -(defun common-types (s1 s2) - (car (intersection - (string-to-clist s1) - (string-to-clist s2)))) - -(defvar shared (mapcar (lambda (x) - (destructuring-bind (s1 s2) x - (common-types s1 s2))) - inputs)) - -(defun priority-map (c) - (if (upper-case-p c) - (+ 27 (- (char-code c) (char-code #\A))) - (+ 1 (- (char-code c) (char-code #\a))))) - -(defvar round-1-answer (reduce #'+ (mapcar #'priority-map shared))) - -;; Round 2 - -;; Simple recursive algorithm which produces consecutive groups of 3 elements -(defun group-by-3 (lst) - (if (null lst) - nil - (cons - (list (car lst) (car (cdr lst)) (car (cdr (cdr lst)))) - (group-by-3 (cdr (cdr (cdr lst))))))) - -;; Note the use of group-by-3 here -(defvar inputs (group-by-3 - (with-input-from-string (s input) - (loop - for line = (read-line s nil) - until (null line) - collect line)))) - -;; Extend intersection to three -(defun common-types-3 (s1 s2 s3) - (car - (intersection - (string-to-clist s1) - (intersection - (string-to-clist s2) - (string-to-clist s3))))) - -;; Extend the destructuring bind and use of common-types-3 -(defvar shared (mapcar (lambda (x) - (destructuring-bind (s1 s2 s3) x - (common-types-3 s1 s2 s3))) - inputs)) - -;; Same as before -(defvar round-2-answer (reduce #'+ (mapcar #'priority-map shared))) diff --git a/2022/puzzle-4.lisp b/2022/puzzle-4.lisp deleted file mode 100644 index 04c7bfb..0000000 --- a/2022/puzzle-4.lisp +++ /dev/null @@ -1,59 +0,0 @@ -;; Example input: a-b,c-d which denotes [a,b] and [c,d] - -;; We want to find if [c,d] < [a,b] or vice versa (complete inclusion) -;; and since we're working with integers, it's simply checking if the -;; bounds are included i.e. c in [a,b] and d in [a,b] - -(defvar input (uiop:read-file-string "2022/4-input")) - -(defun parse-bound (str) - "Given STR=\"a-b\" return (a b)" - (let* ((sep (search "-" str)) - (first (subseq str 0 sep)) - (second (subseq str (+ sep 1)))) - (list (parse-integer first) (parse-integer second)))) - -(defvar completed-parse - (with-input-from-string (s input) - (loop for line = (read-line s nil) - until (null line) - collect - ;; given a-b,c-d we want ((a b) (c d)) - (let* ((sep (search "," line)) - (first-bound (subseq line 0 sep)) - (second-bound (subseq line (+ sep 1)))) - (list (parse-bound first-bound) (parse-bound second-bound)))))) - -(defun complete-inclusion (first-bound second-bound) - (destructuring-bind (a b) first-bound - (destructuring-bind (c d) second-bound - (or - (and - (>= a c) (<= a d) - (>= b c) (<= b d)) - (and - (>= c a) (<= c b) - (>= d a) (<= d b)))))) - -(defvar round-1-answer (length (remove-if #'null - (mapcar (lambda (pair) - (destructuring-bind (first second) pair - (complete-inclusion first second))) - completed-parse)))) - -;; Round 2: any overlap at all. Basically just overhaul the inclusion -;; function and then do the same answer checking. -(defun any-inclusion (first second) - (destructuring-bind (a b) first - (destructuring-bind (c d) second - ;; How about doing this through negation? [a,b] does not overlap with [c,d] at all if either b < c or a > d. - (not - (or - (< b c) - (> a d)))))) - -(defvar round-2-answer (length (remove-if #'null - (mapcar (lambda (pair) - (destructuring-bind (first second) pair - (any-inclusion first second))) - completed-parse)))) 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