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

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

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
                         ;; I am aware this is ugly
                         (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))
              ;; ((<= cstart start end cend)
              ;;  nil)
              )))))

(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"))))
    ;; Originally this had an :element-type however
    ;; Part 2 didn't so I just removed it in both
    (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"exa"
            #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))