commit - /dev/null
commit + 3c0eb59116747361356f7c74d077ec1446a136d1
blob - /dev/null
blob + 71f3e5b7d4b3fde2c73a869b734de3a61b6c65d1 (mode 644)
--- /dev/null
+++ .github/workflows/run-tests.yml
+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))'
blob - /dev/null
blob + a16462c3cfb3c632c311d1d647c041f065f205bc (mode 644)
--- /dev/null
+++ .gitignore
+\#*
+*.fasl
+aoc
\ No newline at end of file
blob - /dev/null
blob + 77b5aa80cc70011f4f77c592d1f095f572c4c5af (mode 644)
--- /dev/null
+++ aoc-test.asd
+(defsystem "aoc-test"
+ :class :package-inferred-system
+ :pathname "t"
+ :depends-on ("aoc-test/all"))
+
+(register-system-packages "aoc-test/all" '("aoc-test"))
blob - /dev/null
blob + a366f960054105dd33c0c837ce314099ded295e5 (mode 644)
--- /dev/null
+++ aoc.asd
+(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"))
blob - /dev/null
blob + 60c03a592deb689774906dce80c7aa6b2e50bd92 (mode 755)
--- /dev/null
+++ build.lisp
+#!/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)
blob - /dev/null
blob + f9502fdbc22266d46561c352bc11f23f7e555d2c (mode 644)
--- /dev/null
+++ src/main.lisp
+(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))))
blob - /dev/null
blob + a8abc0920f0022c1badca89d153f023eb570ddc4 (mode 644)
--- /dev/null
+++ src/utils.lisp
+(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)))
blob - /dev/null
blob + 01d12dd198dd8f67658b20001ad50bf6562fc294 (mode 644)
--- /dev/null
+++ t/all.lisp
+(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))
blob - /dev/null
blob + 7456e45f81411c5c13996ac097695225a82beffd (mode 644)
--- /dev/null
+++ t/utils.lisp
+(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)))))
