I wanted to write some blog posts, but I was short of material. For the fun of it, I’ve decided to write a series of posts about solving the 2024 Advent of Code problems in Common Lisp. I see that other people were doing this in real time, but it is too late for that. Besides, I didn’t want the stress of trying to solve the problems as part of a competition. I wanted to take my time and focus on code quality rather than on how fast I can write it.
I noticed that some programmers were less experienced in Common
Lisp. They tended to code up solutions that used low-level Common
Lisp operations instead of using one of Common Lisp’s powerful
sequence operations. For example, they might use a loop to iterate
over a list and incf a counter instead of just using a
call to count. I want to show how to effectively use
the rich set of Common Lisp library functions to write concise,
readable, and efficient code.
I’m trying to decide what I think of the series
package that provides a more functional approach to iteration
without sacrificing performance. For a lot of iterations, it is
easy to write series code, but it for other iterations it isn’t so
obvious. I wanted a little practice in using series and seeing its
limitations.
Conventions
One of the features of Common Lisp is that you can tailor the
language to fit the problem space. The first step in solving the
problem suite is to configure the language. Since I wanted to
explore using the series package, I set up my Lisp so
that series was available in all the packages. I also
installed the alexandria library, which is a collection
of utilities that flesh out the Common Lisp standard library with
some obvious “missing” functions.
The series package includes an
optional #M reader macro that gives you a shorthand for
writing mapping expressions. I added the “named” let syntax
which attaches a name to the binding lambda of a let
expression allowing you to invoke the reinvoke the let
as a recursive function. The default delarations were set to ensure
that the compiler could would generate tail recursive code. Tail
recursion coupled with named-let is a powerful iteration facility.
I set up the directory structure to have a subdirectory for each
day. Each problem in the entire Advent of Code could fit in its own
solution.lisp file, so each subdirectory had
files input.txt and solution.lisp, and
usually sample-input.txt and maybe one or more
sample-input-n.txt
The parent directory had an advent2024.asd file, a package.lisp
file that defined all the packages, an initialize.lisp
file that customized Common Lisp and installed some bootstrap values
in each package, and a misc.lisp file that contained
some common definitions that were exported to all the packages.
I set up my Lisp to have a separate package for each day. The package definition file contained 25 package definitions, each one virtually identical, e.g.:
(defpackage "ADVENT2024/DAY16"
(:shadow "VALIDATE")
(:import-from "ALEXANDRIA"
"FLATTEN"
"HASH-TABLE-ALIST"
"HASH-TABLE-KEYS"
"HASH-TABLE-VALUES"
"LENGTH="
"MAPPEND"
"MAP-PERMUTATIONS"
"MAP-PRODUCT"
"READ-FILE-INTO-STRING"
"STARTS-WITH-SUBSTRING"
)
(:shadowing-import-from "NAMED-LET" "LET")
(:shadowing-import-from "SERIES"
"DEFUN"
"FUNCALL"
"LET*"
"MULTIPLE-VALUE-BIND"
)
(:export "PART-1" "PART-2" "+SOLUTION-1+" "+SOLUTION-2+" "VALIDATE")
(:use "ADVENT2024" "COMMON-LISP" "FOLD" "FUNCTION" "NAMED-LET" "SERIES"))
This basically set up Lisp to have series available,
and imported a few symbols from alexandria.
Each day’s puzzle has two parts, so each package exports the
symbols PART-1 and PART-2 to be defined as
zero argument functions that compute and return the solution to
the respective parts. The symbols +SOLUTION-1+
and +SOLUTION-2+ are defined
as defparameter values. The initialization function
installs a validate function checks
that (part-1) returns +SOLUTION-1+
and (part-2) returns +SOLUTION-2+ in each package.
misc.lisp
The misc.lisp file contains code that is common to
more than one puzzle.
The grid abstraction
The problem space of many of the puzzles is two dimensional, and it is natural to use a two-dimensional lisp array for the representation. I enhance this with a lightweight abstraction called a grid.
A grid is adressed by a coord, which is an ordered pair
of column and row. These are simply the car
and cdr of a cons cell. The functions that construct
and select from a coord are all
given compiler-macro definitions. In the 99% of the
cases where you simply call the constructor or selector, the
compiler macro will expand the code. In the 1% case, where you pass
the constructor or selector as a first-class function, the function
definition is passed.
(deftype grid-index ()
‘(integer ,(- array-dimension-limit) (,array-dimension-limit)))
(deftype coord ()
’(cons (grid-index) (grid-index)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun coord (column row)
(check-type column grid-index)
(check-type row grid-index)
(cons column row))
)
(define-compiler-macro coord (column row)
‘(cons ,column ,row))
(defun column (coord)
(check-type coord coord)
(car coord))
(define-compiler-macro column (coord)
‘(car ,coord ))
(defun row (coord)
(check-type coord coord)
(cdr coord))
(define-compiler-macro row (coord)
‘(cdr ,coord))
(defun scan-coords (row-count col-count)
(declare (optimizable-series-function))
(multiple-value-bind (rows cols)
(map-fn ’(values grid-index grid-index)
#’floor
(scan-range :below (* row-count col-count))
(series col-count))
(declare (type (series grid-index) rows cols))
(map-fn ’coord #’coord cols rows)))
A grid is just a two-dimensional array of atoms:
(deftype grid () ‘(array atom 2)) (defun make-grid (height width &rest keys) (apply #’make-array (list height width) keys)) (defun row-list->grid (row-list) (make-grid (length row-list) (length (first row-list)) :initial-contents row-list)) (defun grid-height (grid) (check-type grid grid) (array-dimension grid 0)) (define-compiler-macro grid-height (grid) ‘(array-dimension ,grid 0)) (defun grid-width (grid) (check-type grid grid) (array-dimension grid 1)) (define-compiler-macro grid-width (grid) ‘(array-dimension ,grid 1))
A coord is on a grid if it is within the bounds of the grid:
(defun on-grid? (grid coord)
(and (>= (column coord) 0)
(< (column coord) (grid-width grid))
(>= (row coord) 0)
(< (row coord) (grid-height grid))))
You may want to check if the coord is on the grid before calling grid-ref.
(defun grid-ref (grid coord)
(check-type grid grid)
(check-type coord coord)
(aref grid (row coord) (column coord)))
(define-compiler-macro grid-ref (grid coord)
(let ((coord-var (gensym "COORD-")))
‘(let ((,coord-var ,coord))
(aref ,grid (row ,coord-var) (column ,coord-var)))))
(defsetf grid-ref (grid coord) (value)
(let ((coord-var (gensym "COORD-")))
‘(let ((,coord-var ,coord))
(setf (aref ,grid (row ,coord-var) (column ,coord-var)) ,value))))
(defun scan-grid-coords (grid)
(declare (optimizable-series-function))
(scan-coords (grid-height grid) (grid-width grid)))
(defun scan-grid (grid)
(declare (optimizable-series-function 2))
(#2m(lambda (grid coord)
(values coord (grid-ref grid coord)))
(series grid)
(scan-coords (grid-height grid) (grid-width grid))))
You can invert a grid. This will give you a hash table that maps the atoms in the grid to a list of their coords.
(defun invert-grid (grid &optional initial-value)
(if initial-value
(multiple-value-bind (coords vals) (scan-grid grid)
(collect-hash-push-except vals coords (list initial-value)))
(multiple-value-bind (coords vals) (scan-grid grid)
(collect-hash-push vals coords))))
You can extract a row, column, or diagonal from a grid:
(defun grid-row (grid row-number)
(check-type grid grid)
(make-array (list (grid-width grid))
:displaced-to grid
:displaced-index-offset (array-row-major-index grid row-number 0)))
(defun grid-column (grid columm-number)
(check-type grid grid)
(let ((answer (make-array (grid-height grid))))
(dotimes (row (grid-height grid) answer)
(setf (svref answer row)
(grid-ref grid (coord columm-number row))))))
(defun grid-falling-diagonal (grid diagonal-number)
(check-type grid grid)
(let ((start-column (if (minusp diagonal-number)
0
diagonal-number))
(start-row (if (minusp diagonal-number)
(- diagonal-number)
0)))
(let ((limit (min (- (grid-width grid) start-column)
(- (grid-height grid) start-row))))
(let ((answer (make-array (list limit))))
(do ((row start-row (+ row 1))
(column start-column (+ column 1))
(index 0 (+ index 1)))
((>= index limit) answer)
(setf (svref answer index)
(grid-ref grid (coord column row))))))))
(defun grid-rising-diagonal (grid diagonal-number)
(check-type grid grid)
(let ((start-column (if (minusp diagonal-number)
(- diagonal-number)
0))
(start-row (if (minusp diagonal-number)
(1- (grid-height grid))
(- (grid-height grid) diagonal-number 1))))
(let ((limit (min (- (grid-width grid) start-column)
(1+ start-row))))
(let ((answer (make-array (list limit))))
(do ((row start-row (- row 1))
(column start-column (+ column 1))
(index 0 (+ index 1)))
((>= index limit) answer)
(setf (svref answer index)
(grid-ref grid (coord column row))))))))
Given a grid, you can get the series of rows, columns, or diagonals:
(defun scan-rows (grid)
(declare (optimizable-series-function))
(map-fn ’vector #’grid-row (series grid) (scan-range :below (grid-height grid))))
(defun scan-columns (grid)
(declare (optimizable-series-function))
(map-fn ’vector #’grid-column (series grid) (scan-range :below (grid-width grid))))
(defun scan-falling-diagonals (grid)
(declare (optimizable-series-function))
(map-fn ’vector
#’grid-falling-diagonal
(series grid)
(scan-range :from (1+ (- (grid-height grid))) :below (grid-width grid))))
(defun scan-rising-diagonals (grid)
(declare (optimizable-series-function))
(map-fn ’vector
#’grid-rising-diagonal
(series grid)
(scan-range :from (- 1 (grid-width grid)) :below (grid-height grid))))
An orientation is a unit coord.
(deftype unit () ‘(integer -1 1)) (deftype orientation () ’(cons (unit) (unit))) (defun unit-vector (column row) (check-type column unit) (check-type row unit) (cons column row)) (defparameter +north+ (unit-vector 0 -1)) (defparameter +northeast+ (unit-vector 1 -1)) (defparameter +east+ (unit-vector 1 0)) (defparameter +southeast+ (unit-vector 1 1)) (defparameter +south+ (unit-vector 0 1)) (defparameter +southwest+ (unit-vector -1 1)) (defparameter +west+ (unit-vector -1 0)) (defparameter +northwest+ (unit-vector -1 -1))
You can do 2d-vector arithmetic on a coord
(defun 2v+ (left right)
(coord (+ (column left) (column right))
(+ (row left) (row right))))
(defun 2v- (left right)
(coord (- (column left) (column right))
(- (row left) (row right))))
Given a coord, you can get the coord of the
adjacent cell in a given orientation. Note that the
new coord might not be on the grid if you’re at the edge.
(defun coord-north (coord)
(check-type coord coord)
(2v+ coord +north+))
(define-compiler-macro coord-north (coord)
(let ((coord-var (gensym "COORD-")))
‘(let ((,coord-var ,coord))
(coord (column ,coord-var) (1- (row ,coord-var))))))
(defun coord-northeast (coord)
(check-type coord coord)
(2v+ coord +northeast+))
(define-compiler-macro coord-northeast (coord)
(let ((coord-var (gensym "COORD-")))
‘(let ((,coord-var ,coord))
(coord (1+ (column ,coord-var)) (1- (row ,coord-var))))))
(defun coord-east (coord)
(check-type coord coord)
(2v+ coord +east+))
(define-compiler-macro coord-east (coord)
(let ((coord-var (gensym "COORD-")))
‘(let ((,coord-var ,coord))
(coord (1+ (column ,coord-var)) (row ,coord-var)))))
(defun coord-southeast (coord)
(check-type coord coord)
(2v+ coord +southeast+))
(define-compiler-macro coord-southeast (coord)
(let ((coord-var (gensym "COORD-")))
‘(let ((,coord-var ,coord))
(coord (1+ (column ,coord-var)) (1+ (row ,coord-var))))))
(defun coord-south (coord)
(check-type coord coord)
(2v+ coord +south+))
(define-compiler-macro coord-south (coord)
(let ((coord-var (gensym "COORD-")))
‘(let ((,coord-var ,coord))
(coord (column ,coord-var) (1+ (row ,coord-var))))))
(defun coord-southwest (coord)
(check-type coord coord)
(2v+ coord +southwest+))
(define-compiler-macro coord-southwest (coord)
(let ((coord-var (gensym "COORD-")))
‘(let ((,coord-var ,coord))
(coord (1- (column ,coord-var)) (1+ (row ,coord-var))))))
(defun coord-west (coord)
(check-type coord coord)
(2v+ coord +west+))
(define-compiler-macro coord-west (coord)
(let ((coord-var (gensym "COORD-")))
‘(let ((,coord-var ,coord))
(coord (1- (column ,coord-var)) (row ,coord-var)))))
(defun coord-northwest (coord)
(check-type coord coord)
(2v+ coord +northwest+))
(define-compiler-macro coord-northwest (coord)
(let ((coord-var (gensym "COORD-")))
‘(let ((,coord-var ,coord))
(coord (1- (column ,coord-var)) (1- (row ,coord-var))))))
An ocoord is a coord that has a direction associated
with it. It is a coord plus
an orientation.
(deftype ocoord () ’(cons coord orientation)) (defun ocoord (coord orientation) (check-type coord coord) (check-type orientation orientation) (cons coord orientation)) (define-compiler-macro ocoord (coord orientation) ‘(cons ,coord ,orientation)) (defun ocoord-coord (ocoord) (check-type ocoord ocoord) (car ocoord)) (define-compiler-macro ocoord-coord (ocoord) ‘(car ,ocoord)) (defun ocoord-orientation (ocoord) (check-type ocoord ocoord) (cdr ocoord)) (define-compiler-macro ocoord-orientation (ocoord) ‘(cdr ,ocoord))
The point of an ocoord is to be able to take a step
forward in the direction of the orientation, or to turn
clockwise or counterclockwise.
(defun ocoord-advance (ocoord)
(check-type ocoord ocoord)
(ocoord (2v+ (ocoord-coord ocoord) (ocoord-orientation ocoord))
(ocoord-orientation ocoord)))
(define-compiler-macro ocoord-advance (ocoord)
(let ((ocoord-var (gensym "OCOORD-")))
‘(let ((,ocoord-var ,ocoord))
(ocoord (2v+ (ocoord-coord ,ocoord-var) (ocoord-orientation ,ocoord-var))
(ocoord-orientation ,ocoord-var)))))
(defun ocoord-cw (ocoord)
(check-type ocoord ocoord)
(ocoord (ocoord-coord ocoord)
(cond ((equal (ocoord-orientation ocoord) +north+) +east+)
((equal (ocoord-orientation ocoord) +east+) +south+)
((equal (ocoord-orientation ocoord) +south+) +west+)
((equal (ocoord-orientation ocoord) +west+) +north+))))
(defun ocoord-ccw (ocoord)
(check-type ocoord ocoord)
(ocoord (ocoord-coord ocoord)
(cond ((equal (ocoord-orientation ocoord) +north+) +west+)
((equal (ocoord-orientation ocoord) +east+) +north+)
((equal (ocoord-orientation ocoord) +south+) +east+)
((equal (ocoord-orientation ocoord) +west+) +south+))))
The grid input to many of the puzzles is presented as “ASCII art” characters in a file. For example, the input might look like this:
....#..... .........# .......... ..#....... .......#.. .......... .#..^..... ........#. #......... ......#...
To read this into a grid, we’ll need a function that converts a string into a list of atoms. We’ll need a function that converts a char to an atom:
(defun string-mapper (char-fn)
"Returns a function that maps strings to lists."
(lambda (line)
(collect ’list
(map-fn ’t
char-fn
(scan ’string line)))))
We can use this to read the input file into a grid:
(defun read-file-into-grid (char-fn filename)
"Returns the contents of the file as a two-dimensional array."
(row-list->grid
(collect ’list
(map-fn ’list
(string-mapper char-fn)
(scan-file filename #’read-line)))))
char-fn is called on each character in the file. If
it is #’identity, then the grid will be a grid of
characters. However, we usually want a grid of atoms, so we supply
a function that converts a character to an atom.
(defun char->decimal (char)
(- (char-code char) (char-code #\0)))
(defun char-interner (char-folder package)
(lambda (char)
(if (digit-char-p char)
(char->decimal char)
(intern (string (funcall char-folder char)) package))))
We can use this to read the input file into a grid:
;; Case folding (read-file-into-grid (char-interner #’char-upcase *package*) "input.txt") ;; Case preserving (read-file-into-grid (char-interner #’identity *package*) "input.txt")
Other miscellaneous functions
advent-pathname converts a relative pathname to an absolute pathname in the
advent2024 directory. advent-pathname is
used to find the input files.
(defun advent-pathname (pathname)
(merge-pathnames pathname
(asdf/system:system-source-directory "advent2024")))
cartesian-product-list takes a list of lists and returns a list of
lists that are the cartesian product of the input lists. For
example, (cartesian-product-list ’((1 2) (3 4))) returns
((1 3) (1 4) (2 3) (2 4)).
(defun map-cons (car cdrs)
(map ’list (lambda (cdr) (cons car cdr)) cdrs))
(defun cartesian-product (&rest lists)
(cartesian-product-list lists))
(defun cartesian-product-list (lists)
(fold-left (lambda (tails terms)
(mappend (lambda (term)
(map-cons term tails))
terms))
(list nil)
(reverse lists)))
integer-log is used to find the number of digits an
integer has in a given base.
(defun integer-log (n base)
"Returns two values, the integer-log of <n> in <base>, and the leftmost digit
in <base>."
(if (< n base)
(values 0 n)
(multiple-value-bind (ilog l) (integer-log n (* base base))
(if (< l base)
(values (* ilog 2) l)
(values (+ (* ilog 2) 1) (/ l base))))))
Miscellaneous list functions
I gave the miscellaneous list functions as a puzzle in a previous post. I’ll repeat them here for convenience.
map-pairs takes a list of items and maps a function
over all pairs of items. For example:
(map-pairs #’list ’(1 2 3)) ((1 2) (1 3) (1 4) (2 3) (2 4) (3 4))
revmap is like map, but it returns a list in
reverse order.
revmap-cons, given a car and list of cdrs, returns a
list of lists where each list has the car and one of the cdrs. The
lists are returned in reverse order.
revmappend is like mappend, but it returns the list in
reverse order.
remove-one-element returns a list of lists. Each sublist
is the input list with one element removed.
Miscellaneous scanner
scan-suffixes takes a sequence and returns a series of
the suffixes of the sequence. If include-empty? is
true (the default), then the empty sequence is the last suffix.
If proper? is true (default false), then the original
full sequence is omitted from the series.
Armed with these miscellaneous functions, we can tackle the puzzles. I’ll write up some solutions in the next few posts.
No comments:
Post a Comment