My AoC 2025 solutions in Common Lisp.
Day #01🔗
Part #01🔗
(with-open-file (f #P"./01")
(print
(loop :for position := 50 :then (mod (funcall dirf position distance) 100)
:for direction := (read-char f nil :eof)
:until (eq direction :eof)
:for dirf := (if (char= #\R direction) #'+ #'-)
:for distance := (read f)
:do (print (list :position position
:direction direction
:dirf dirf
:distance distance))
:count (zerop position))))
with Ada.Text_IO;
use Ada.Text_IO;
procedure Main is
buffer : String (1 .. 15);
is_right : Boolean;
last : Integer;
input : File_Type;
type Dial is mod 100;
position : Dial := 50;
distance : Dial;
zeroes : Natural := 0;
begin
Open(
File => input,
Name => "01-input",
Mode => In_File
);
while not End_Of_File(input) loop
Get_Line (
Item => buffer,
Last => last,
File => input
);
is_right := 'R' = buffer(1);
distance := Dial'Mod(Natural'Value(buffer(2..last)));
position := position + (if is_right
then distance
else - distance);
if position = 0 then
zeroes := zeroes + 1;
end if;
end loop;
Close(input);
Put_Line(Integer'Image(zeroes));
end;
Part #02🔗
(defconstant +wheel-size+ 100)
(with-open-file (f #P"./01")
(let ((zeroes 0) (dial 50))
(labels ((turn-dial (dir) (setf dial (mod (+ dial dir) +wheel-size+)))
(check () (if (zerop dial) (incf zeroes)))
(up () (turn-dial +1) (check))
(down () (turn-dial -1) (check)))
(loop :for direction := (read-char f nil :eof)
:until (eq direction :eof)
:for dirf := (if (char= #\R direction) #'up #'down)
:for distance := (read f)
:do (loop :for i :below distance
:do (funcall dirf))))
(print zeroes)))
Day #02🔗
Part #01🔗
(defun invalid-id-p (num)
(block nil
(let* ((num-str (format nil "~a" num))
(num-len (length num-str)))
(if (oddp num-len) (return nil))
(let* ((halfway-point (truncate num-len 2))
(left
(str:substring 0 halfway-point num-str))
(right
(str:substring halfway-point num-len num-str)))
(string= left right)))))
(let* ((input-string
(uiop:with-input-file (f #P"./input")
(uiop:slurp-stream-string f)))
(input-data
(mapcar
(lambda (range)
(mapcar #'parse-integer
(str:split #\- range)))
(str:split
#\,
(str:trim input-string)))))
(print
(loop :for (from to) :in input-data
:sum
(loop :for id :from from :to to
:if (invalid-id-p id)
:sum id))))
pragma Ada_2022;
with Ada.Text_IO;
procedure Main is
use Ada.Text_IO;
type Big is range 0 .. 2**64 - 1;
package IIO is new Integer_IO (Big);
Input_Path : constant String := "input";
Input : File_Type;
Sum_Of_Invalid : Big := 0;
Bottom : Big;
Top : Big;
C : Character;
procedure Parse_Range (Left, Right : out Big) is
begin
IIO.Get (Input, Left);
Get (Input, C);
pragma Assert (C = '-');
IIO.Get (Input, Right);
end Parse_Range;
function Invalid_Id_P (Num : Big) return Boolean is
S : String := Num'Image;
begin
if S'Length mod 2 = 0 then
return False;
end if;
declare
S_Midpoint : Positive := (S'First + S'Last) / 2;
Lhs : String := S (S'First + 1 .. S_Midpoint);
Rhs : String := S (S_Midpoint + 1 .. S'Last);
begin
pragma Assert (Lhs'Length = Rhs'Length);
return Lhs = Rhs;
end;
end Invalid_Id_P;
procedure Iterate_Ids is
begin
for I in Bottom .. Top loop
if Invalid_Id_P (I) then
Sum_Of_Invalid := @ + I;
end if;
end loop;
end Iterate_Ids;
begin
Open (File => Input, Name => Input_Path, Mode => In_File);
loop
Parse_Range (Bottom, Top);
Iterate_Ids;
exit when End_Of_File (Input);
Get (Input, C);
pragma Assert (C = ',');
end loop;
Close(Input);
Put_Line (Sum_Of_Invalid'Image);
end Main;
Part #02🔗
(defun invalid-id-p (num)
(let* ((num-str (format nil "~a" num)))
(not (zerop (cl-ppcre:count-matches "^(.*)\\1+$" num-str)))))
(let* ((input-string (str:from-file #P"./input"))
(input-data
(mapcar
(lambda (range)
(mapcar #'parse-integer
(str:split #\- range)))
(str:split
#\,
(str:trim input-string)))))
(print
(loop :for (from to) :in input-data
:sum
(loop :for id :from from :to to
:if (invalid-id-p id)
:sum id))))
Day #03🔗
Part #01🔗
(defun get-first-max-from (data start notlast)
(loop :with (max max-idx)
:for idx :from start :below (- (length data) (if notlast 1 0))
:for char := (aref data idx)
:if (or (not max) (char< max char))
:do (setf max char max-idx idx)
:finally (return
(values max max-idx))))
(let* ((data (str:from-file #P"input"))
(banks (str:lines data)))
(print
(loop :for bank :in banks
:for (first first-idx) := (multiple-value-list (get-first-max-from bank 0 t))
:for second := (get-first-max-from bank (1+ first-idx) nil)
:sum (parse-integer (format nil "~c~c" first second)))))
Part #02🔗
(defun get-first-max-from (data start end)
(loop :with (max max-idx)
:for idx :from start :below end
:for char := (aref data idx)
:if (or (not max) (char< max char))
:do (setf max char max-idx idx)
:finally (return
(values max max-idx))))
(defconstant +max-batteries+ 12)
(let* ((data (str:from-file #P"input"))
(banks (str:lines data)))
(print
(loop :for bank :in banks
:sum
(print
(parse-integer
(format
nil "~{~c~}"
(loop :for battery :from 11 :downto 0
:for (char char-idx)
:= (multiple-value-list
(get-first-max-from
bank
(if char-idx
(1+ char-idx) 0)
(- (length bank) battery)))
:collect char)))))))
Day #04🔗
Common🔗
(defconstant +paper+ #\@)
(defvar *input*
(let* ((input-str (str:from-file #P"input"))
(input-split (str:lines input-str)))
(make-array (list (length input-split)
(length (car input-split)))
:initial-contents input-split
:element-type 'character)))
Part #01🔗
(print
(loop :with (height width) := (array-dimensions *input*)
:for y :from 0 :below height
:sum (loop :for x :from 0 :below width
:if (char= +paper+ (aref *input* y x))
:count (let ((neighbours
(loop :for delta-y :from -1 :to 1
:sum
(loop
:for delta-x :from -1 :to 1
:unless (= 0 delta-x delta-y)
:count (ignore-errors
(char=
+paper+
(aref *input*
(+ y delta-y)
(+ x delta-x))))))))
(> 4 neighbours)))))
Part #02🔗
(defun find-extractable ()
(loop :with (height width) := (array-dimensions *input*)
:for y :from 0 :below height
:nconc (loop :for x :from 0 :below width
:if (char= +paper+ (aref *input* y x))
:if (let ((neighbours
(loop :for delta-y :from -1 :to 1
:sum
(loop
:for delta-x :from -1 :to 1
:unless (= 0 delta-x delta-y)
:count (ignore-errors
(char=
+paper+
(aref *input*
(+ y delta-y)
(+ x delta-x))))))))
(> 4 neighbours))
:collect (list x y))))
(print
(loop :for extracts := (find-extractable)
:for len := (length extracts)
:until (zerop len)
:sum len
:do (loop :for (x y) :in extracts
:do (setf (aref *input* y x) #\.))))
Day #05🔗
Common🔗
(defvar *lines*
(str:lines
(str:trim
(str:from-file #P"input"))))
(defvar *ranges*
(loop :for line := (pop *lines*)
:until (str:emptyp line)
:collect (mapcar #'parse-integer
(str:split "-" line))))
(defvar *nums*
(mapcar #'parse-integer *lines*))
Part #01🔗
(defun in-range (num range)
(<= (car range) num (cadr range)))
(defun in-ranges (num)
(find-if
(alexandria:curry #'in-range num)
*ranges*))
(print (count-if #'identity (mapcar #'in-ranges *nums*)))
Part #02🔗
(defun merge-ranges ()
(let ((sr (sort *ranges* #'< :key #'car)))
(serapeum:with-collector (collect)
(loop
:with (cstart cend) := (car sr)
:for (start end) :in (cdr sr)
:finally (collect (list cstart cend))
:do (log4cl:log-info cstart cend start end)
:do (cond
((< cend start)
(collect (list cstart cend))
(setf cstart start
cend end))
((<= cstart start cend end)
(setf cend end))
)))))
(defun sum-ranges (ranges)
(loop :for (start end) :in ranges
:sum (1+ (- end start))))
(print (sum-ranges (print (merge-ranges))))
Day #06🔗
Part #01🔗
(defvar *nums*)
(defvar *ops*)
(let* ((lines
(str:lines
(str:from-file #P"input")))
(nums
(mapcar (lambda (line)
(mapcar #'parse-integer
(str:words line)))
(butlast lines))))
(setf *nums*
(make-array
(list (length nums)
(length (car nums)))
:initial-contents nums)
*ops*
(mapcar
#'find-symbol
(str:words
(car (last lines))))))
(print
(iter
(for y below (array-dimension *nums* 1))
(for op in *ops*)
(sum
(iter
(for x below (array-dimension *nums* 0))
(reducing (aref *nums* x y) by op)))))
Part #02🔗
(defun transpose (arr)
(let ((height (length arr))
(width (length (aref arr 0))))
(iter
(for x below width)
(collect
(coerce
(iter
(for y below (1- height))
(collect (aref (aref arr y) x)))
'string)))))
(let* ((lines
(str:lines
(str:from-file #P"input")))
(transposed-lines
(transpose (apply #'vector lines)))
(nums
(mapcar
(lambda (line)
(mapcar #'parse-integer line))
(split-sequence:split-sequence-if
#'str:blank? transposed-lines)))
(ops
(mapcar
#'find-symbol
(str:words
(car (last lines))))))
(print
(reduce #'+
(mapcar
(lambda (op nums) (apply op nums))
ops nums))))
Day #07🔗
Common🔗
(defconstant +emitter+ #\S)
(defconstant +tachyon+ #\|)
(defconstant +space+ #\.)
(defconstant +splitter+ #\^)
(defvar *input*
(let ((lines (str:lines
(str:from-file #P"input"))))
(make-array (list (length lines) (length (car lines)))
:initial-contents lines)))
(defvar *emitter-idx*)
(let ((first-line (make-array (array-dimension *input* 1)
:displaced-to *input*)))
(setf
*emitter-idx* (position +emitter+ first-line)
(aref *input* 1 *emitter-idx*) +tachyon+))
Part #01🔗
(print
(iter
(for y from 1 below (array-dimension *input* 0))
(sum
(iter
(for x below (array-dimension *input* 1))
(case (aref *input* y x)
((#.+space+)
(when (char= (aref *input* (1- y) x) +tachyon+)
(setf (aref *input* y x) +tachyon+)))
((#.+splitter+)
(when (char= (aref *input* (1- y) x) +tachyon+)
(setf (aref *input* y (1+ x)) +tachyon+
(aref *input* y (1- x)) +tachyon+)
(counting t))))))))
Part #02🔗
(iter
(with last = (1- (array-dimension *input* 0)))
(for x below (array-dimension *input* 1))
(setf (aref *input* last x) 1))
(iter
(for y from (1- (array-dimension *input* 0)) downto 1)
(iter
(for x below (array-dimension *input* 1))
(when (and
(eq +space+ (aref *input* y x))
(typep (aref *input* (1+ y) x) 'number))
(setf (aref *input* y x)
(aref *input* (1+ y) x))))
(iter
(for x below (array-dimension *input* 1))
(when (eq +splitter+ (aref *input* y x))
(let ((l (aref *input* y (1+ x)))
(r (aref *input* y (1- x))))
(when (and (typep r 'number)
(typep l 'number))
(setf (aref *input* (1- y) x) (+ l r)))))))
(print *input*)
(print (aref *input* 1 *emitter-idx*))
Day #08🔗
Today I have to thank varjagg for their cl-union-find library.
Common🔗
(defconstant +dims+ 3)
(defvar *input*
(let ((lines
(str:lines
(str:from-file
#P"input"
))))
(make-array
(list (length lines) +dims+)
:initial-contents
(mapcar
(lambda (line)
(mapcar
#'parse-integer
(str:split #\, line)))
lines)
:element-type 'integer)))
(defun point-dist (x y)
(sqrt
(iter
(for dim below +dims+)
(sum
(expt
(- (aref *input* x dim)
(aref *input* y dim))
2)))))
(defstruct dist
x y value)
(defvar point-cnt (array-dimension *input* 0))
(defvar dists
(make-array
(/ (expt point-cnt 2) 2)
:fill-pointer 0))
(iter
(for x below point-cnt)
(iter
(for y from (1+ x) below point-cnt)
(for dist = (point-dist x y))
(vector-push
(make-dist
:x x :y y :value dist)
dists)))
Part #01🔗
(defconstant +n-largest+ 3)
(defconstant +n-shortest+ 1000)
(let* ((p (cl-uf:make-partition :test #'eq))
(connections
(subseq
(sort dists #'< :key #'dist-value)
0 +n-shortest+)))
(iter
(for d in-vector connections)
(let ((sx
(cl-uf:make-set
p (dist-x d)))
(sy
(cl-uf:make-set
p (dist-y d))))
(unless (eq sx sy)
(cl-uf:union p sx sy))))
(let ((final-circuits
(subseq
(sort
(mapcar
(lambda (s)
(coerce
(cl-uf:collect-set
p s)
'vector))
(remove-duplicates
(iter
(for x below point-cnt)
(collect
(cl-uf:make-set p x)))))
#'> :key #'length)
0 +n-largest+)))
(print
(reduce #'* final-circuits
:key #'length))))
Part #02🔗
(defvar *connections-to-go* (1- (array-dimension *input* 0)))
(block ex
(let* ((p (cl-uf:make-partition :test #'eq))
(connections
(sort dists #'< :key #'dist-value)))
(iter
(for d in-vector connections)
(let ((sx
(cl-uf:make-set
p (dist-x d)))
(sy
(cl-uf:make-set
p (dist-y d))))
(unless (eq sx sy)
(cl-uf:union p sx sy)
(decf *connections-to-go*)
(when (zerop *connections-to-go*)
(print (*
(aref *input* (dist-x d) 0)
(aref *input* (dist-y d) 0)))
(return-from ex)))))))
Day #09🔗
Today again, I used a library, this time for the geometry.
Common🔗
(defconstant +dims+ 2)
(defvar *input*
(let ((lines
(str:lines
(str:from-file #P"input"))))
(make-array
(list (length lines) +dims+)
:initial-contents
(mapcar
(lambda (line)
(mapcar
#'parse-integer
(str:split #\, line)))
lines)
:element-type 'integer)))
(defun scalar-dist (x y)
(1+ (abs (- x y))))
(defun point-dist (x y)
(* (scalar-dist (aref *input* x 0)
(aref *input* y 0))
(scalar-dist (aref *input* x 1)
(aref *input* y 1))))
Part #01🔗
(let* ((point-cnt (array-dimension *input* 0)))
(print
(iter
(for x below point-cnt)
(maximize
(iter
(for y from (1+ x) below point-cnt)
(for dist = (point-dist x y))
(maximize dist into m)
(declare (fixnum m))
(finally (return m)))))))
Part #02🔗
(defvar *world*
(apply #'geometry:make-polygon-from-coords
(coerce (make-array
(reduce #'* (array-dimensions *input*))
:displaced-to *input*) 'list)))
(defun coord-list (x y)
(let ((x1 (aref *input* x 0))
(y1 (aref *input* x 1))
(x2 (aref *input* y 0))
(y2 (aref *input* y 1)))
(list x1 y1 x1 y2 x2 y1 x2 y2)))
(let* ((point-cnt (array-dimension *input* 0))
(current-max 0))
(iter
(for x in (alexandria:shuffle
(loop :for x :below point-cnt :collect x)))
(iter
(for y in (alexandria:shuffle
(loop :for y :from (1+ x) :below point-cnt :collect y)))
(for dist = (point-dist x y))
(when (> dist current-max)
(incf checked-times)
(ignore-errors
(unless (geometry:polygon-difference
(apply #'geometry:make-polygon-from-coords
(coord-list x y))
*world*)
(setf current-max dist))))))
(print current-max))
Day #10🔗
Everybody spoke about Z3, so I figured I’d give it a go.
Part #01🔗
(defun parse-line (l)
(let* ((w (str:words l))
(lights (car w))
(light-array
(map 'vector
(alexandria:curry #'char= #\#)
(str:substring 1 -1 lights)))
(buttons (butlast (cdr w)))
(parsed-buttons
(iter
(for btn in buttons)
(collect
(mapcar #'parse-integer
(str:split #\, (str:substring 1 -1 btn))))))
(btn-array
(make-array (length light-array)
:initial-element nil)))
(iter
(for idx from 0)
(for btn in parsed-buttons)
(iter (for connection in btn)
(push idx (aref btn-array connection))))
(cons light-array btn-array)))
(defvar *input*
(mapcar
#'parse-line
(str:lines
(str:from-file #P"input"))))
(print *input*)
(defun emit-z3 (prob stream)
(let* ((*standard-output* stream)
(lights (car prob))
(btns (cdr prob))
(max-btn (reduce #'max btns
:key (alexandria:curry #'reduce #'max))))
(iter
(for idx from 0 to max-btn)
(format t "(declare-const x~a Int)~%" idx)
(format t "(assert (>= x~a 0))~%" idx))
(format t "(define-fun evenp ((a Int)) Bool (= 0 (mod a 2)))~%")
(format t "(define-fun oddp ((a Int)) Bool (not (= 0 (mod a 2))))~%")
(iter
(for btn in-vector btns)
(for light in-vector lights)
(format t "(assert (~a (+ ~{x~a~^ ~})))~%"
(if light "oddp" "evenp")
btn))
(format t "(minimize (+ ~{x~a~^ ~}))~%"
(iter (for x to max-btn) (collect x)))
(format t "(check-sat)~%")
(format t "(get-model)~%")
(terpri)))
(defun run-z3 (prob)
(with-input-from-string (s
(with-output-to-string (s)
(emit-z3 prob s)))
(let ((s
(str:substring 4 nil
(uiop:run-program
(list "," "z3" "/dev/stdin")
:input s
:output :string
:error-output :interactive))))
(reduce #'+
(mapcar (alexandria:compose #'car #'last)
(read-from-string s))))))
(format t "~%~%Finally: ~a"
(iter
(for prob in *input*)
(summing
(print
(run-z3 prob)))))
Part #02🔗
Part 2 required just two edits more or less thanks to the way I did part 1:
12,16c12,19
< (lights (car w))
< (light-array
< (map 'vector
< (alexandria:curry #'char= #\#)
< (str:substring 1 -1 lights)))
---
> (joltages (car (last w)))
> (joltage-array
> (coerce
> (mapcar #'parse-integer
> (str:split
> #\,
> (str:substring 1 -1 joltages)))
> 'vector))
25c28
< (make-array (length light-array)
---
> (make-array (length joltage-array)
32c35
< (cons light-array btn-array)))
---
> (cons joltage-array btn-array)))
47c50
< (lights (car prob))
---
> (joltages (car prob))
56,57d58
< (format t "(define-fun evenp ((a Int)) Bool (= 0 (mod a 2)))~%")
< (format t "(define-fun oddp ((a Int)) Bool (not (= 0 (mod a 2))))~%")
60,62c61,63
< (for light in-vector lights)
< (format t "(assert (~a (+ ~{x~a~^ ~})))~%"
< (if light "oddp" "evenp")
---
> (for joltage in-vector joltages)
> (format t "(assert (= ~a (+ ~{x~a~^ ~})))~%"
> joltage
Day #11🔗
Common🔗
(defstruct machine
id conns)
(defvar *input*
(iter
(for lin in
(str:lines
(str:from-file
#P"input"
)))
(collect
(destructuring-bind (id connections-string) (str:split #\: lin)
(make-machine
:id id :conns (str:words connections-string))))))
(defun make-hash-table-from-keys (sequence &key key test)
(iter
(with ht = (make-hash-table :test test :size (length sequence)))
(for el in sequence)
(setf (gethash (funcall key el) ht) el)
(finally (return ht))))
(defvar *lookup*
(make-hash-table-from-keys
*input*
:key #'machine-id
:test #'equal))
Part #01🔗
(defun render-path-cnts (mach)
(alexandria:when-let ((cnt (machine-path-cnt mach)))
(return-from render-path-cnts cnt))
(setf (machine-path-cnt mach)
(iter
(for conn in (machine-conns mach))
(sum
(if (string= conn "out")
1
(render-path-cnts (gethash conn *lookup*)))))))
Part #02🔗
I tried a memoize library but it corrupted something?
(let ((*cache* (make-hash-table :test #'equal)))
(defun render-path-cnts (mach dac fft)
(with-slots (id conns) mach
(let ((cache-ident (list id dac fft)))
(alexandria:when-let ((r (gethash cache-ident *cache*)))
(return-from render-path-cnts r))
(cond
((string= id "dac") (setf dac t))
((string= id "fft") (setf fft t)))
(setf (gethash cache-ident *cache*)
(iter
(for conn in (machine-conns mach))
(sum
(if (string= conn "out")
(if (and dac fft) 1 0)
(render-path-cnts (gethash conn *lookup*) dac fft)))))))))
(print
(render-path-cnts (gethash "svr" *lookup*) nil nil))
Day #12🔗
(defvar *input*
(mapcar
(lambda (line)
(destructuring-bind
(size tiles)
(str:split #\: line)
(cons (mapcar #'parse-integer (str:split #\x size))
(mapcar #'parse-integer (str:words tiles)))))
(subseq
(str:lines
(str:from-file
#P"input"))
(* 5 6))))
(print
(iter
(for prob in *input*)
(for size = (car prob))
(for tiles = (cdr prob))
(for totsize = (reduce #'* size))
(for totiles = (reduce #'+ tiles :key (lambda (tile) (* tile 3 3))))
(count (<= totiles totsize))))