From 55a352a08e09c38e9a68c7b5547f36c6b206e643 Mon Sep 17 00:00:00 2001 From: Aryadev Chavali Date: Sun, 7 Dec 2025 07:52:17 +0000 Subject: [PATCH] aoc 2025 - still need to 7 Forgot to push these all onto the cloud lol --- 2025/puzzle-1.lisp | 40 ++++++++++++ 2025/puzzle-2.lisp | 64 ++++++++++++++++++ 2025/puzzle-3.lisp | 65 +++++++++++++++++++ 2025/puzzle-4.lisp | 75 ++++++++++++++++++++++ 2025/puzzle-5.lisp | 50 +++++++++++++++ 2025/puzzle-6.lisp | 99 ++++++++++++++++++++++++++++ 2025/util.lisp | 157 +++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 550 insertions(+) create mode 100644 2025/puzzle-1.lisp create mode 100644 2025/puzzle-2.lisp create mode 100644 2025/puzzle-3.lisp create mode 100644 2025/puzzle-4.lisp create mode 100644 2025/puzzle-5.lisp create mode 100644 2025/puzzle-6.lisp create mode 100644 2025/util.lisp diff --git a/2025/puzzle-1.lisp b/2025/puzzle-1.lisp new file mode 100644 index 0000000..5409a1c --- /dev/null +++ b/2025/puzzle-1.lisp @@ -0,0 +1,40 @@ +(load "util.lisp") + +(defpackage "aoc:1" + (:use :cl "aoc-util")) + +(in-package "aoc:1") + +(fn round-1 (turns) (=> list fixnum) + (loop with dial = 50 + with number-of-zeros = 0 + for (rotation . magnitude) in turns + do (setf dial (mod (funcall rotation dial magnitude) 100)) + if (= dial 0) + do (incf number-of-zeros) + finally (return number-of-zeros))) + +(fn round-2 (turns) (=> list fixnum) + (loop with dial = 50 + with number-of-zeros = 0 + for (rotation . magnitude) in turns + ;; FUCK I have to do this manually, too many edge cases + do (loop for i from 1 to magnitude + for new-dial-value = (funcall rotation dial 1) + if (or (= new-dial-value 0) (= new-dial-value 100)) + do (incf number-of-zeros) + do (setf dial (mod new-dial-value 100))) + finally (return number-of-zeros))) + +(let ((turns (loop for line in (uiop:read-file-lines "1-input") + for (rotation magnitude) = (->> line (split 1) multiple-value-list) + collect (cons (if (string= rotation "L") + #'- + #'+) + (parse-integer* magnitude))))) + (->> turns + round-1 + (format t "Round 1: ~a~%")) + (->> turns + round-2 + (format t "Round 2: ~a~%"))) diff --git a/2025/puzzle-2.lisp b/2025/puzzle-2.lisp new file mode 100644 index 0000000..2a5a6ad --- /dev/null +++ b/2025/puzzle-2.lisp @@ -0,0 +1,64 @@ +(load "util.lisp") + +(defpackage "aoc:2" + (:use :cl "aoc-util")) + +(in-package "aoc:2") + +(fn parse-input (filename) (=> string list) + (loop for item in (-<> (uiop:read-file-string filename) + (uiop:split-string :separator '(#\,))) + for split-range = (uiop:split-string item :separator '(#\-)) + collect (mapcar ($>> (string-trim '(#\space)) parse-integer*) split-range))) + +(fn invalid-id-1 (n) (=> fixnum boolean) + (let ((str (format nil "~a" n))) + (if (= 1 (mod (length str) 2)) + nil + (let ((items (multiple-value-list (split (/ (length str) 2) str)))) + (string= (car items) (cadr items)))))) + +(fn round-1 (id-ranges) (=> list fixnum) + (loop with invalid-ids = 0 + for (lower upper) in id-ranges + do (loop for i from lower to upper + if (invalid-id-1 i) + do (incf invalid-ids i)) + finally (return invalid-ids))) + +(fn invalid-id-2 (n) (=> fixnum boolean) + (loop + ;; Loop setup + with str = (format nil "~a" n) + with window-len = 1 + with window-str = (subseq str 0 1) + with i = 1 + + while (< i (length str)) + for chunk = (subseq str i (min (length str) (+ i window-len))) + if (< (length chunk) window-len) + return nil + if (string= chunk window-str) + ;; check the next chunk + do (incf i window-len) + else + ;; we need to increase the size of our window + do (setf window-len (1+ i) + window-str (subseq str 0 window-len) + i (1+ i)) + finally (return (->> str length (= window-len) not)))) + +(fn round-2 (id-ranges) (=> list fixnum) + (->> id-ranges + (mapcar (lambda (range) (range (car range) (cadr range)))) + (mapcar ($>> (remove-if-not #'invalid-id-2))) + (mapcar ($>> (reduce #'+))) + (reduce #'+))) + +(let ((input (parse-input "2-input"))) + (->> input + round-1 + (format t "Round 1: ~a~%")) + (->> input + round-2 + (format t "Round 2: ~a~%"))) diff --git a/2025/puzzle-3.lisp b/2025/puzzle-3.lisp new file mode 100644 index 0000000..a8dec74 --- /dev/null +++ b/2025/puzzle-3.lisp @@ -0,0 +1,65 @@ +(load "util.lisp") + +(defpackage "aoc:3" + (:use :cl "aoc-util")) + +(in-package "aoc:3") + +(fn compose-joltage (x y) (=> (integer integer) integer) + (->> x (* 10) (+ y))) + +(fn maximum (xs) (=> list cons) + (--> _ + (loop for x in xs maximizing x) + (cons _ (position _ xs)))) + +(fn best-joltage-1 (bank) (=> list cons) + (destructuring-bind (max-val . max-pos) (maximum bank) + (if (->> bank length 1- (= max-pos)) + ;; best value at end => next best is the first digit + (cons (->> bank length 1- + (subseq bank 0) + maximum car) + max-val) + ;; best value not at end => next best is the second digit + (->> max-pos 1+ + (subseq bank) + maximum car + (cons max-val))))) + +(fn round-1 (banks) (=> list fixnum) + (loop for bank in banks + for (first-digit . second-digit) = (best-joltage-1 bank) + sum (compose-joltage first-digit second-digit))) + +(fn best-joltage-2 (bank) (=> list fixnum) + #| Sliding window greedy search? + + We look at a sequence of digits in bank, choose the best one, then move onto + the next window. We need the windows, at all times, to have enough digits for + us to pick a good one from. In this case we need to choose 12, so at any one + time we need to be examining at most 12 digits (decrementing as we get more + digits). The next window needs to be _after_ the position of the best value + we picked in our current window. |# + (loop + with window-start = 0 + for n from 12 downto 1 + for window = (subseq bank window-start (-<> bank length 1+ (- n))) + for (max-val . max-pos) = (maximum window) + do (setf window-start (+ max-pos 1 window-start)) + collect max-val into digits + finally (return (reduce #'compose-joltage digits)))) + +(fn round-2 (banks) (=> list integer) + (->> banks (mapcar #'best-joltage-2) (reduce #'+))) + +(let ((input (loop for line in (uiop:read-file-lines "3-input") + for chars = (coerce line 'list) + for digit-strings = (mapcar #'string chars) + collect (mapcar #'parse-integer* digit-strings)))) + (->> input + round-1 + (format t "Round 1: ~a~%")) + (->> input + round-2 + (format t "Round 2: ~a~%"))) diff --git a/2025/puzzle-4.lisp b/2025/puzzle-4.lisp new file mode 100644 index 0000000..18cec79 --- /dev/null +++ b/2025/puzzle-4.lisp @@ -0,0 +1,75 @@ +(load "util.lisp") + +(defpackage "aoc:4" + (:use :cl "aoc-util")) + +(in-package "aoc:4") + +(fn valid-cell-coord (graph x y) (=> (list fixnum fixnum) boolean) + (and (>= x 0) (< x (length graph)) + (>= y 0) (< y (length (car graph))))) + +(fn get-cell (graph x y) (=> (list fixnum fixnum) (or null character)) + (if (valid-cell-coord graph x y) + (->> graph (nth x) (nth y)) + nil)) + +(fn adjacent-cell-coords (graph x y) (=> (list fixnum fixnum) cons) + (loop + for x_ from (1- x) to (1+ x) + nconc + (loop + for y_ from (1- y) to (1+ y) + for cell = (get-cell graph x_ y_) + if cell + collect (list x_ y_ cell)))) + +(fn get-rolls-with-adjacent-rolls (graph) (=> list cons) + (loop + for x from 0 + for row in graph + nconc + (loop + for y from 0 + for cell in row + if (char= cell #\@) + collect + (->> (adjacent-cell-coords graph x y) + (remove-if-not ($>> (nth 2) (char= #\@))) + length + (list x y))))) + + +(fn get-good-rolls (graph) (=> list list) + (->> graph + get-rolls-with-adjacent-rolls + (remove-if ($>> (nth 2) (< 4))))) + +(fn round-1 (graph) (=> list fixnum) + (->> graph + get-good-rolls + length)) + +(fn remove-cells (graph cells) (=> (list list) list) + (loop for (x y) in cells + do (setf (->> graph (nth x) (nth y)) #\.)) + graph) + +(fn round-2 (graph) (=> list fixnum) + (loop + for good-rolls = (get-good-rolls graph) + while (/= (length good-rolls) 0) + sum (length good-rolls) + do (->> good-rolls + (mapcar ($<> (subseq 0 2))) + (remove-cells graph) + (setf graph)))) + +(let ((input (->> (uiop:read-file-lines "4-input") + (mapcar #'(lambda (x) (coerce x 'list)))))) + (->> input + round-1 + (format t "Round 1: ~a~%")) + (->> input + round-2 + (format t "Round 2: ~a~%"))) diff --git a/2025/puzzle-5.lisp b/2025/puzzle-5.lisp new file mode 100644 index 0000000..ca72671 --- /dev/null +++ b/2025/puzzle-5.lisp @@ -0,0 +1,50 @@ +(load "util.lisp") + +(defpackage "aoc:5" + (:use :cl "aoc-util")) + +(in-package "aoc:5") + +(fn parse-input (input) (=> list (values list list)) + (let ((input (-<> (position "" input :test #'string=) + (split input) + multiple-value-list))) + (values + (loop for range in (car input) + for bounds = (uiop:split-string range :separator '(#\-)) + collect (mapcar #'parse-integer* bounds)) + (mapcar #'parse-integer* (cdadr input))))) + +(fn in-range (n range) (=> (integer list) boolean) + (destructuring-bind (lower upper) range + (and (<= n upper) (>= n lower)))) + +(fn round-1 (ranges items) (=> (list list) fixnum) + (loop + for item in items + sum + (loop + for range in ranges + if (in-range item range) + return 1 + finally (return 0)))) + +(fn round-2 (ranges) (=> list integer) + (loop + with ranges = (sort ranges #'(lambda (x y) (< (car x) (car y)))) + with end = 0 + for (lower upper) in ranges + if (> lower end) + sum (1+ (- upper lower)) ;add the size of the range to our running total + and do (setf end upper) ;make the end of our current range the upper bound + else + ;; (lower, upper) contained in ranges => remove the intersect + sum (- (max upper end) end) + and do (setf end (max upper end)))) + +(let ((input (uiop:read-file-lines "5-input"))) + (multiple-value-bind (ranges items) (parse-input input) + (->> (round-1 ranges items) + (format t "Round 1: ~a~%")) + (->> (round-2 ranges) + (format t "Round 2: ~a~%")))) diff --git a/2025/puzzle-6.lisp b/2025/puzzle-6.lisp new file mode 100644 index 0000000..169248b --- /dev/null +++ b/2025/puzzle-6.lisp @@ -0,0 +1,99 @@ +(load "util.lisp") + +(defpackage "aoc:6" + (:use :cl "aoc-util")) + +(in-package "aoc:6") + +;; Computation, once we have everything parsed, is trivial... +(fn compute (operand-sets ops) (=> (list list) fixnum) + (loop for operands in operand-sets + for op in ops + sum (apply op operands))) + +;; What do you think this does? +(fn transpose (matrix) (=> list list) + (loop for i from 1 to (length (car matrix)) + collect + (loop + for row in matrix + collect (nth (1- i) row)))) + +(fn parse-op (op) (=> string function) + (if (string= op "+") #'+ #'*)) + +(fn parse-input (filename) (=> string (values list list)) + ;; Returns (lines representing operands, parsed operators) + (let* ((lines (uiop:read-file-lines filename)) + (last (car (last lines)))) + (values (->> lines length 1- + (subseq lines 0)) + (->> last + uiop:split-string + (remove-if ($>> (string= ""))) + (mapcar #'parse-op))))) + +;; The end of triviality +(fn parse-operand-sets-1 (operand-sets) (=> list list) + (->> + ;; Split every line in operand-sets by whitespace, deleting any trivial + ;; strings + (loop for op-set in operand-sets + collect (->> + op-set + uiop:split-string + (remove-if ($>> (string= ""))))) + ;; transpose the operand set to get the right operands + transpose + ;; parse the integers contained in every op-set + (mapcar ($>> (mapcar #'parse-integer))))) + +(fn is-separator? (op-sets col) (=> (list fixnum) boolean) + ;; Given a column, whitespace on every row => it's not a value + (every (lambda (c) (char= c #\space)) + (loop for row in op-sets + collect (nth col row)))) + +(fn parse-operand-sets-2 (operand-sets) (=> list list) + ;; converts operand-sets into that weird cephalopod writing system + + ;; convert op-sets into a list of lists of chars + (let ((op-sets (mapcar ($<> (coerce 'list)) operand-sets)) + columns) + (loop + with col-size = (length (car op-sets)) + with index = 0 + while (< index (col-size op-sets)) + + ;; Skip any separators + do + (loop while (and (< index col-size) + (is-separator? op-sets index)) + do (incf index)) + + ;; Extract a column till the next separator + do + (loop while (and (< index col-size) + (not (is-separator? op-sets index))) + collect (loop for row in op-sets collect (nth index row)) into xs + do (incf index) + finally (setf columns (append columns (list xs))))) + + ;; Columns is now a set of groups of columns (by separator). Each item in a + ;; group is a set of characters. Let's clean that up into groups of + ;; integers. + (-<> ($>> + (mapcar ($>> (call-rev coerce 'string) + parse-integer*))) + (mapcar columns)))) + +(multiple-value-bind (operand-sets ops) (parse-input "6-input") + (->> operand-sets + parse-operand-sets-1 + (call-rev compute ops) + (format t "Round 1: ~a~%")) + + (->> operand-sets + parse-operand-sets-2 + (call-rev compute ops) + (format t "Round 2: ~a~%"))) diff --git a/2025/util.lisp b/2025/util.lisp new file mode 100644 index 0000000..41df3d4 --- /dev/null +++ b/2025/util.lisp @@ -0,0 +1,157 @@ +(defpackage "aoc-util" + (:use :cl) + (:export + :=> + :--> :->> :-<> + :$-> :$<> :$>> + :alist-val :call-rev :fn + :split :rev-map :parse-integer* :remove-at-indices :range)) + +(in-package "aoc-util") + +(deftype => (args result) + "Type level DSL for function types" + `(function ,(typecase args + (null args) + (symbol (list args)) + (otherwise args)) + ,result)) + +(defmacro --> (placeholder &body forms) + "Lexically bind current form as `placeholder' for use in the next form, returning +the result of the last form. + +i.e. + +(--> (a1 a2...) (b1 b2...) (c1 c2...)) = +(let* ((placeholder (a1 a2 ...)) + (placeholder (b1 b2 ...)) + (placeholder (c1 c2 ...))) + _ ) + +Also includes transformer where symbols are considered unary functions i.e. +(--> x y) <-> (--> x (y placeholder)). +" + (if (null forms) + nil + (let ((assignment-forms + (loop :for i :from 0 + :for f :in forms + :for canon-f := (if (and (> i 0) (symbolp f)) + (list f placeholder) + f) + :collect `(,placeholder ,canon-f)))) + `(let* ,assignment-forms + ,placeholder)))) + +(defmacro ->> (&rest forms) + "Make current form the last argument of the next form, returning the last + form. + +i.e. +(->> (a1 a2...) (b1 b2...) (c1 c2...)) == (c1 c2 ... (b1 b2 ... (a1 a2 ...))) + +Also includes transformer where symbols are considered unary functions. + +Like the `|>' operator in Ocaml." + (if (null forms) + nil + (loop :with acc = (car forms) + :for func :in (cdr forms) + :for canon-func = (if (symbolp func) (list func) func) + :do (setq acc (append canon-func (list acc))) + :finally (return acc)))) + +(defmacro -<> (&rest forms) + "Make current form the first argument of the next form, returning the last + form. + +i.e. +(-<> (a1 a2...) (b1 b2...) (c1 c2...)) == (c1 (b1 (a1 a2 ...) b2 ...) c2 ...) + +Also includes transformer where symbols are considered unary functions. + +Like the `|>' operator in Ocaml." + (if (null forms) + nil + (loop :with acc = (car forms) + :for func :in (cdr forms) + :for canon-func = (if (symbolp func) (list func) func) + :do (push acc (cdr canon-func)) + :do (setq acc canon-func) + :finally (return acc)))) + +(defmacro $-> (capture &rest forms) + "Given a sequence of FORMS, return a unary function which applies each form +sequentially via -->" + `(lambda (,capture) + (--> ,capture ,capture ,@forms))) + +(defmacro $<> (&rest forms) + "Given a sequence of FORMS, return a unary function which applies each form +sequentially via -<>" + (let ((capture (gensym))) + `(lambda (,capture) + (-<> ,capture ,@forms)))) + +(defmacro $>> (&rest forms) + "Given a sequence of FORMS, return a unary function which applies each form +sequentially via ->>" + (let ((capture (gensym))) + `(lambda (,capture) + (->> ,capture ,@forms)))) + +(defmacro alist-val (key alist &key (test #'eq)) + "Helper macro for getting the value of KEY in ALIST." + `(cdr (assoc ,key ,alist :test ,test))) + +(defmacro call-rev (func-name &rest arguments) + "Call a function with arguments but in reverse +i.e. (call-rev f x1 x2 ... xn) => (f xn ... x2 x1)." + `(,func-name ,@(reverse arguments))) + +(defmacro fn (name lambda-list type &body body) + "Construct a function `NAME' with a declared function type `TYPE' that takes +arguments `LAMBDA-LIST' with body `BODY'." + `(progn + (declaim (ftype ,type ,name)) + (defun ,name ,lambda-list + ,@body))) + +(fn split (n lst) (=> (fixnum sequence) (values sequence sequence)) + "Return CONS where CAR is the first N elements of LST and CDR is the rest." + (if (< (length lst) n) + (values nil nil) + (values (subseq lst 0 n) + (subseq lst n)))) + +(fn rev-map (indicator lst &key (test #'eq)) + (=> (function sequence &key (:test function)) list) + "Given LST and INDICATOR: LST -> A, return an association list A -> 2^LST +where key x in A has associations {y in LST : INDICATOR(y) = x}." + (loop :with assoc-list := nil + :for element :in (coerce lst 'list) + :for key := (funcall indicator element) + :for value := (cdr (assoc key assoc-list :test test)) + :if value + :do (setf (alist-val key assoc-list :test test) + (cons element value)) + :else + :do (setq assoc-list (-<> (list key element) (cons assoc-list))) + :finally (return assoc-list))) + +(fn parse-integer* (inp) (=> string (or integer list)) + "Given string INP, attempt to parse an integer. Return NIL otherwise." + (parse-integer inp :junk-allowed t)) + +(fn remove-at-indices (indices lst) (=> (list sequence) list) + "Given a set of INDICES and a list LST, return a copy of LST without items at any +index in INDICES." + (loop :for i :from 0 :to (1- (length lst)) + :for item :in (coerce lst 'list) + :if (not (member i indices)) + :collect item)) + +(fn range (lower upper) (=> (fixnum fixnum) list) + (loop for i from lower to upper + collect i))