oreodave/dotfiles
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

(2022)-deleted puzzle files

Browse Source 
I think I did this by accident, check out
https://git.aryadevchavali.com/advent-of-code/ for my actual advent of
code runs.
This commit is contained in:
Aryadev Chavali
2023-07-13 15:33:49 +01:00
parent 70e2e26eb1
commit 93b8ae4620
5 changed files with 0 additions and 354 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
2022/puzzle-1.lisp
View File

@@ -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)))

54
2022/puzzle-2.lisp
View File

@@ -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))))))

67
2022/puzzle-3.lisp
View File

@@ -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)))

59
2022/puzzle-4.lisp
View File

@@ -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))))

148
2022/puzzle-5.lisp
View File

@@ -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)))