oreodave/advent-of-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

aoc 2025 - still need to 7

Browse Source 
Forgot to push these all onto the cloud lol
This commit is contained in:
Aryadev Chavali
2025-12-07 07:52:17 +00:00
parent 61aa2c1ded
commit 55a352a08e
7 changed files with 550 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
2025/puzzle-1.lisp Normal file
View File

@@ -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~%")))

64
2025/puzzle-2.lisp Normal file
View File

@@ -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~%")))

65
2025/puzzle-3.lisp Normal file
View File

@@ -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~%")))

75
2025/puzzle-4.lisp Normal file
View File

@@ -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~%")))

50
2025/puzzle-5.lisp Normal file
View File

@@ -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~%"))))

99
2025/puzzle-6.lisp Normal file
View File

@@ -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~%")))

157
2025/util.lisp Normal file
View File

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