advent-of-code-2024

My solutions to AoC 2024
Log | Files | Refs

commit 3c0eb59116747361356f7c74d077ec1446a136d1
Author: Lukas Henkel <lh@entf.net>
Date:   Sat, 30 Nov 2024 12:50:15 +0100

Initial commit

Diffstat:
A.github/workflows/run-tests.yml | 64++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A.gitignore | 4++++
Aaoc-test.asd | 6++++++
Aaoc.asd | 8++++++++
Abuild.lisp | 22++++++++++++++++++++++
Asrc/main.lisp | 131+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Asrc/utils.lisp | 210+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
At/all.lisp | 24++++++++++++++++++++++++
At/utils.lisp | 58++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
9 files changed, 527 insertions(+), 0 deletions(-)

diff --git a/.github/workflows/run-tests.yml b/.github/workflows/run-tests.yml @@ -0,0 +1,64 @@ +name: CI + +on: + push: + branches: [ "master" ] + + workflow_dispatch: + +env: + SBCL_VERSION: 2.3.11 + +jobs: + build: + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v3 + + - name: "Cache: SBCL" + id: cache-sbcl + uses: actions/cache@v3.3.2 + with: + path: "~/sbcl" + key: "${SBCL_VERSION}" + + - name: "Cache: .sbclrc" + uses: actions/cache@v3.3.2 + with: + path: "~/.sbclrc" + key: "${SBCL_VERSION}" + + - name: "Cache: Quicklisp" + uses: actions/cache@v3.3.2 + with: + path: "~/quicklisp" + key: always-restore + + - name: "Cache: asdf config" + uses: actions/cache@v3.3.2 + with: + path: "~/.config/common-lisp" + key: always-restore + + - name: "Cache: asdf cache" + uses: actions/cache@v3.3.2 + with: + path: "~/.cache/common-lisp" + key: always-restore + + - name: "Install SBCL" + uses: cheeze2000/setup-sbcl@v1 + with: + version: $SBCL_VERSION + if: steps.cache-sbcl.outputs.cache-hit != 'true' + + - name: "Add SBCL to PATH" + run: echo "/home/runner/sbcl/bin" >> $GITHUB_PATH + if: steps.cache-sbcl.outputs.cache-hit == 'true' + + - name: "Test" + run: | + sbcl --non-interactive \ + --eval '(ql:quickload (list :aoc :aoc-test))' \ + --eval '(unless (asdf:test-system :aoc) (uiop:quit 1))' diff --git a/.gitignore b/.gitignore @@ -0,0 +1,3 @@ +\#* +*.fasl +aoc +\ No newline at end of file diff --git a/aoc-test.asd b/aoc-test.asd @@ -0,0 +1,6 @@ +(defsystem "aoc-test" + :class :package-inferred-system + :pathname "t" + :depends-on ("aoc-test/all")) + +(register-system-packages "aoc-test/all" '("aoc-test")) diff --git a/aoc.asd b/aoc.asd @@ -0,0 +1,8 @@ +(defsystem "aoc" + :class :package-inferred-system + :pathname "src" + :depends-on ("aoc/main") + :in-order-to ((test-op (load-op "aoc-test"))) + :perform (test-op (o c) (symbol-call :aoc-test :test-all))) + +(register-system-packages "aoc/main" '("aoc")) diff --git a/build.lisp b/build.lisp @@ -0,0 +1,22 @@ +#!/bin/sh +#| +exec sbcl --script "build.lisp" +|# +(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" + (user-homedir-pathname)))) + (when (probe-file quicklisp-init) + (load quicklisp-init))) +(push (probe-file #P".") asdf:*central-registry*) + +(sb-ext:restrict-compiler-policy 'speed 3 3) +(push :release *features*) + +(ql:quickload :aoc) +(loop for day from 1 to 25 + for system-name = (format nil "aoc/day-~A" day) + for system = (asdf:find-system system-name nil) + when system + do (ql:quickload system-name)) +(sb-ext:save-lisp-and-die "aoc" + :toplevel #'aoc:main + :executable t) diff --git a/src/main.lisp b/src/main.lisp @@ -0,0 +1,131 @@ +(defpackage #:aoc/main + (:use #:cl) + (:import-from #:alexandria) + (:import-from #:local-time) + (:import-from #:dexador) + (:nicknames #:aoc) + (:export + #:today + #:run-day + #:new-day + #:main)) +(in-package #:aoc/main) + +(defconstant +year+ 2024) + +(defvar *system* (asdf:find-system '#:aoc)) + +(defvar *cookie* nil) + +(defun system-pathname (file) + (asdf:system-relative-pathname *system* file)) + +(defun input-pathname (day) + (system-pathname (format nil "input/~A.txt" day))) + +(defun source-pathname (day) + (system-pathname (format nil "src/day-~A.lisp" day))) + +(defun test-pathname (day) + (system-pathname (format nil "t/day-~A.lisp" day))) + +(defun transform-input (input day) + (typecase input + (pathname + (values + (open input) + #'close)) + (string + (values + (make-string-input-stream input) + #'close)) + (stream + (values + input + nil)) + (null + (values + (open (input-pathname day)) + #'close)))) + +(defun day-fun (day) + (let* ((fun (format nil "DAY-~A" day)) + (package (format nil "AOC/~A" fun)) + (package (or (find-package package) + (progn + (asdf:load-system (string-downcase package)) + (find-package package)))) + (fun (find-symbol fun package))) + (symbol-function fun))) + +(defun today () + (local-time:timestamp-day (local-time:now))) + +(defun run-day (&optional (day (today)) input) + (multiple-value-bind (input cleanup) + (transform-input input day) + (unwind-protect + (funcall (day-fun day) input) + (when cleanup + (funcall cleanup input))))) + +(defun new-day (&optional (day (today))) + (let ((input-pathname (input-pathname day)) + (source-pathname (source-pathname day)) + (test-pathname (test-pathname day))) + (ensure-directories-exist input-pathname) + (ensure-directories-exist test-pathname) + (unless (probe-file input-pathname) + (restart-case + (unless *cookie* + (error "Advent Of Code cookie is unset")) + (use-cookie (cookie) + :interactive (lambda () + (format t "Cookie: ") + (list (read-line))) + (setf *cookie* cookie))) + (alexandria:write-string-into-file + (dex:get (format nil "https://adventofcode.com/~A/day/~A/input" +year+ day) + :cookie-jar (cookie:make-cookie-jar + :cookies (list (cookie:make-cookie :name "session" + :value *cookie* + :domain ".adventofcode.com")))) + input-pathname)) + (values + (unless (probe-file source-pathname) + (with-open-file (stream source-pathname :direction :output) + (let ((fun (make-symbol (format nil "DAY-~A" day))) + (package (make-symbol (format nil "AOC/DAY-~A" day))) + (*print-case* :downcase)) + (format stream "~S~%~S~%~%(defun ~A (input)~% )" + `(defpackage ,package + (:use #:cl #:aoc/utils) + (:export + ,fun)) + `(in-package ,package) + fun))) + ;; return function, makes it easy to jump into the file from Emacs + (day-fun day)) + (unless (probe-file test-pathname) + (let ((package (make-symbol (format nil "AOC-TEST/DAY-~A" day))) + (*print-case* :downcase)) + (with-open-file (stream test-pathname :direction :output) + (format stream "~S~%~S~%~%(define-test test-day-~A~% ()~% )" + `(defpackage ,package + (:use #:cl #:lisp-unit2)) + `(in-package ,package) + day)) + (asdf:load-system (format nil "aoc-test/day-~A" day)) + (symbol-function + (find-symbol (format nil "TEST-DAY-~A" day) + (find-package package)))))))) + +(defun main () + (let* ((args (uiop:command-line-arguments)) + (today (or (first args) + (today))) + (input (or (and #1=(second args) + (parse-namestring #1#)) + (input-pathname today)))) + (dolist (task (multiple-value-list (time (run-day today input)))) + (format t "~A~%" task)))) diff --git a/src/utils.lisp b/src/utils.lisp @@ -0,0 +1,210 @@ +(uiop:define-package #:aoc/utils + (:use #:cl) + (:mix-reexport #:alexandria #:serapeum #:split-sequence + #:group-by #:str #:queues) + (:import-from #:queues.simple-queue) + (:import-from #:queues.priority-queue) + (:export + #:read-input + #:read-input-fields + #:read-input-match + #:char-number + #:make-map + #:print-map + #:input-map + #:input-map-width + #:input-map-height + #:map-cell + #:map-integer-at + #:point+ + #:point- + #:point-x + #:point-y + #:point-neighbours + #:manhattan-distance + #:do-map-neighbours + #:read-number-list + #:find-pattern)) +(in-package #:aoc/utils) + +(defun normalize-type (type) + (cond + ((or (eq type 'string) + (null type)) + 'simple-string) + ((eq type 'number) + 'integer) + (t type))) + +(defun wrap-nullable (converter) + (lambda (line) + (if (= (length line) 0) + nil + (funcall converter line)))) + +(defun get-type-converter (type) + (wrap-nullable + (if (functionp type) + type + (ecase (normalize-type type) + (simple-string #'identity) + (integer #'parse-integer) + (keyword (compose #'make-keyword #'string-upcase)))))) + +(defun read-input (input &key (type 'string)) + (loop with converter = (get-type-converter type) + for line = (read-line input nil) + while line + collect (funcall converter line))) + +(defun convert-fields (converters fields) + (loop for converter in converters + for field = (pop fields) + collect (funcall converter field))) + +(defun read-input-fields (input field-types &key (delimiter " ")) + (loop with converters = (mapcar #'get-type-converter + field-types) + for line = (read-line input nil) + while line + collect (convert-fields converters + (split-sequence delimiter line :test #'string=)))) + +(defun read-input-match (input regex &key types) + (loop with scanner = (ppcre:create-scanner regex) + with converters = (and types (mapcar #'get-type-converter types)) + for line = (read-line input nil) + for groups = (and line + (multiple-value-bind (match groups) + (ppcre:scan-to-strings scanner line) + (and match (coerce groups 'list)))) + while groups + collect (if converters + (convert-fields converters groups) + groups))) + + +(declaim (ftype (function (character) fixnum) char-number) + (inline char-number)) +(defun char-number (char) + (- (char-int char) 48)) + +(defstruct input-map + (data nil :type (simple-array simple-string)) + (width 0 :type fixnum) + (height 0 :type fixnum)) + +(defun make-map (input) + (loop with width = nil + with data = nil + for row = (read-line input nil) + for height from 0 + while (and row (> (length row) 0)) + when (= height 0) + do (setf width (length row)) + do (push row data) + finally (return (and data + (make-input-map :data (coerce (nreverse data) 'vector) + :width width + :height height))))) + +(defun print-map (map &key (stream *standard-output*)) + (loop for y from 0 below (input-map-height map) + do (format stream "~A~%" (aref (input-map-data map) y)))) + +(declaim (inline point+ point- point-x point-y) + (ftype (function (cons) fixnum) point-x point-y)) + +(defun point-x (point) + (car point)) + +(defun point-y (point) + (cdr point)) + +(defun point+ (point-a point-b) + (cons (the fixnum (+ (point-x point-a) + (point-x point-b))) + (the fixnum (+ (point-y point-a) + (point-y point-b))))) + +(defun point- (point-a point-b) + (cons (the fixnum (- (point-x point-a) + (point-x point-b))) + (the fixnum (- (point-y point-a) + (point-y point-b))))) + +(declaim (inline map-cell map-integer-at (setf map-cell)) + (ftype (function (input-map cons) character) map-cell) + (ftype (function (character input-map cons) character) (setf map-cell))) + +(defun map-cell (map point) + (aref (aref (input-map-data map) + (point-y point)) + (point-x point))) + +(defun (setf map-cell) (new map point) + (let ((row (aref (input-map-data map) + (point-y point)))) + (setf (aref row (point-x point)) new))) + +(defun map-integer-at (map point) + (parse-integer (aref (input-map-data map) (point-y point)) + :start (point-x point) + :junk-allowed t)) + +(defparameter *map-neighbours* (loop for y from -1 to 1 + nconc (loop for x from -1 to 1 + when (not (and (= y 0) + (= x 0))) + collect (cons x y)))) + +(defun point-neighbours (point) + (mapcar (curry #'point+ point) + *map-neighbours*)) + +(defun manhattan-distance (from to) + (+ (abs (- (point-x to) + (point-x from))) + (abs (- (point-y to) + (point-y from))))) + +(defmacro do-map-neighbours ((neighbour-point map start-point) &body body) + (with-gensyms (width height lb? rb? tb? bb?) + (once-only ((sp start-point) + (mp map)) + `(let* ((,width (input-map-width ,mp)) + (,height (input-map-height ,mp)) + (,lb? (> (point-x ,sp) 0)) + (,rb? (< (point-x ,sp) (1- ,width))) + (,tb? (> (point-y ,sp) 0)) + (,bb? (< (point-y ,sp) (1- ,height)))) + ,@(loop for nb in *map-neighbours* + collect `(let ((,neighbour-point (point+ ,sp ',nb))) + (when (and ,@(let ((checks)) + (when (< (point-x nb) 0) + (push lb? checks)) + (when (< (point-y nb) 0) + (push tb? checks)) + (when (> (point-x nb) 0) + (push rb? checks)) + (when (> (point-y nb) 0) + (push bb? checks)) + checks)) + ,@body))))))) + +(defun read-number-list (string &key (start 0)) + (loop for i from start below (length string) + collect (multiple-value-bind (number end) + (parse-integer string + :start i + :junk-allowed t) + (setf i end) + number))) + +(defun find-pattern (list &optional (minimum-length 5)) + (loop for length from minimum-length to (floor (/ (length list) 2)) + when (loop for i below length + for c-1 = (elt list i) + for c-2 = (elt list (+ i length)) + always (= c-1 c-2)) + do (return-from find-pattern length))) diff --git a/t/all.lisp b/t/all.lisp @@ -0,0 +1,24 @@ +(defpackage #:aoc-test/all + (:use #:cl #:lisp-unit2) + (:nicknames #:aoc-test) + (:import-from #:aoc-test/utils) + (:export + #:test-day + #:test-all)) +(in-package #:aoc-test/all) + +(defun test-day (&optional (day (aoc:today))) + (run-tests :package (format nil "AOC-TEST/DAY-~A" day) + :run-contexts 'with-summary-context)) + +;; TODO: the recursive asdf/ql stuff might not be so great here +(defun test-all () + (run-tests :tests (nconc + (get-tests :package '#:aoc-test/utils) + (loop for day from 1 to 25 + for system-name = (format nil "aoc-test/day-~A" day) + for system = (asdf:find-system system-name nil) + when system + do (ql:quickload system-name) + and nconc (get-tests :package (string-upcase system-name)))) + :run-contexts 'with-summary-context)) diff --git a/t/utils.lisp b/t/utils.lisp @@ -0,0 +1,58 @@ +(uiop:define-package #:aoc-test/utils + (:use #:cl) + (:mix #:lisp-unit2 #:aoc/utils)) +(in-package #:aoc-test/utils) + +(define-test test-read-input + () + (with-input-from-string (stream "hello +world") + (assert-equalp '("hello" "world") + (read-input stream))) + (with-input-from-string (stream "1 +2 +3 + +3 +2 +1") + (assert-equalp '(1 2 3 nil 3 2 1) + (read-input stream :type 'integer))) + (with-input-from-string (stream "this +does +not +matter") + (assert-equalp '(1 1 1 1) + (read-input stream :type (lambda (line) + (declare (ignore line)) + 1))))) + +(define-test test-read-input-fields + () + (with-input-from-string (stream "A 1 +B 2 +C 3 +D +E 5 + +G 7") + (assert-equalp '(("A" 1) + ("B" 2) + ("C" 3) + ("D" nil) + ("E" 5) + (nil nil) + ("G" 7)) + (read-input-fields stream '(string integer))))) + +(define-test test-read-input-match + () + (with-input-from-string (stream "x: 1, y: 2 +x: 3, y: 4 +x: 2, y: 5") + (assert-equalp '(("x" 1 "y" 2) + ("x" 3 "y" 4) + ("x" 2 "y" 5)) + (read-input-match stream + "(\\w+): (\\d+), (\\w+): (\\d+)" + :types '(string integer string integer)))))