λ

Advent of Code

Table of Contents

[in package AOC]

λ

1 Links

Here is the github repo and here is the website.

λ

2 Background

I have always aspired to a more spacious form
that would be free from the claims of poetry or prose
and would let us understand each other without exposing
the author or reader to sublime agonies.

What do we want from a program? For a long time, I have wondered what it would mean to have truly readable programs. I agree with Peter Seibel that code is not literature and yet, I cannot help but imagine a world where software supports our understanding.

Source code, like language, is a weak medium for humans. Many of the things we care about cannot be captured in source code:

Automated testing can capture some small fragments of these details but too much is left to us to reconstruct using our imagination and experience. This is a large part of why gaining comfort with a new codebase doesn't come from passive reading but active rewriting.

I continue to believe that the best way to combat these limitations comes from live environments that allow runtime inspection of in-memory structures and support for inspecting, redefining, and migrating both code and data in a live environment. I also recognize that, unlike the fantasies of my youth, most people have no interest in looking under the hood at how a program functions or how the machine carries out its tasks. And industry will continue moving away from systems that are entirely comprehensible by a single individual.

This program won't overcome these limitations in understanding. It will not reveal all its contextual mysteries and the baggage of its creation to those who read it or run it. But I enjoy programming most when it is a creative writing exercise. So I will try to make this program open to exploration, document a little of what I understand, and show some compassion for myself and you, dear reader.

λ

3 Structure

Readers will note that each day has some common themes:

Each function has a distinct role:

  1. BUILD-DATA, responsible for parsing the input into a usable representation

  2. PART-1, responsible for solving the first part using parsed input

  3. PART-2, responsible for solving the second part using parsed input

These three functions have optional inputs which default to the data file from AOC. They are optional to allow mocking in tests. Tests are in a separate ASDF system and rely only on these three functions.

λ

4 Utilities

[in package AOC.UTIL]

A collection of helpful utilities for working on Advent of Code problems. There are 3 utilities of primary interest:

  1. DEFSUMMARY, which is responsible for generating the summary of a day

  2. READ-DAY-INPUT, which is responsible for reading the input file for the day

  3. SCAFFOLD, which fetches the input file and prepares the code file based on a template

SCAFFOLD is really only of interest at the REPL.

λ

5 Advent 2022

λ

5.1 Calorie Counting

[in package AOC.2022.01 with nicknames 2022.01]
Overview

Requirements - Day 01

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     373kb  

Part 1:

Time:   0.000ms  Memory:       0kb  Answer:  70374

Part 2:

Time:   0.000ms  Memory:       0kb  Answer:  204610
Reflections

As usual, the first day is a straightforward warmup problem. We are given a list of lists of integers and asked to find the sublist that has the largest sum. Each integer is on a separate line and the sublists are separated by a blank line.

Parsing

Parsing is made much easier thanks to my READ-DAY-INPUT macro. I can use its :separator option to group the input into sublists and then map over the sublists with PARSE-INVENTORY.

Inside PARSE-INVENTORY I make use of Serapeum's handy threading macro ~>> to construct a pipeline for parsing and summing the elements in the sublist.

(defun parse-inventory (inventory)
  (~>> (split "\\n" inventory)
       (mapcar #'parse-integer)
       (reduce #'+)))

(defun build-data (&optional input)
  (read-day-input #'parse-inventory :separator "\\n\\n" :input input))

Part 1

With so much work handled in the parsing step, we can simply use Lisp's MAX on the parsed input to arrive at the answer for part 1.

(defun part-1 (&optional (data (build-data)))
  (apply 'max data))

Part 2

Part 2 asks us to figure out the total of the 3 largest sublists. Easy enough. We'll lean on the ~>> macro again and simply sort the parsed input, then sum the first 3 items.

(defun total-snacks (snacks)
  (~>> (sort snacks #'>)
       (subseq _ 0 3)
       (reduce #'+)))

λ

5.2 Rock Paper Scissors

[in package AOC.2022.02 with nicknames 2022.02]
Overview

Requirements - Day 02

Solution - Source on Github

Results

Input Parsing:

Time:   4.001ms  Memory:     589kb  

Part 1:

Time:   0.000ms  Memory:       0kb  Answer:  12156

Part 2:

Time:   0.000ms  Memory:       0kb  Answer:  10835
Reflections

The second day was actually pretty interesting this year. It asks us to interpret a series of single-round rock paper scissors games. Each line in the input consists of two moves, one for the opponent and the player. There's a heuristic for scoring the games and we are asked to find the total score for the games played. Even though the ask is simple and I found an brute force solution quickly, I went through three iterations before arriving at something I really liked. The insight that satisfied me was that there are only 9 possible games of single-round RPS, so we can model the scoring as a search problem.

Parsing

Parsing is simple, I just convert the characters in each line to symbols. This simplifies equality testing as Common Lisp uses different predicates for symbols and strings. (EQL(0 1) vs EQUAL)

(defun parse-move (input)
  (list (make-keyword (char input 0))
        (make-keyword (char input 2))))

(defun build-data (&optional input)
  (read-day-input #'parse-move :input input))

Part 1

First we model the possible *GAMES* and their scores based on the puzzle requirements. The PLAY function will take a list of attributes from a game and find the unique matching game, returning its score. With that in place, TOTAL-SCORE can be a simple reducer over the games.

(defvar *games*
  '((:a :x :draw 4)
    (:a :y :win  8)
    (:a :z :lose 3)
    (:b :x :lose 1)
    (:b :y :draw 5)
    (:b :z :win  9)
    (:c :x :win  7)
    (:c :y :lose 2)
    (:c :z :draw 6))
  "A list of all possible 1-round games of Rock, Paper, Scissors.
In the format: (opponent-move player-move result score)")

(defun play (input)
  (flet ((match? (game)
           (every (op (member _ game)) input)))
    (declare (dynamic-extent #'match?))
    (lastcar (find-if #'match? *games*))))

(defun total-score (games key-fn)
  (reduce #'+ games :key key-fn))

(defun part-1 (&optional (data (build-data)))
  (total-score data #'play))

Part 2

The curveball in Part 2 is that we should treat the player choice not as the move to throw, but the outcome to achieve. Since we know the opponent's move in advance, we can just map the second input to an outcome and reuse PLAY's matching behavior.

(defun choose-outcome (game)
  (let ((outcome-map '(:x :lose :y :draw :z :win)))
    (setf (second game) (getf outcome-map (second game)))
    (play game)))

λ

5.3 Rucksack Reorganization

[in package AOC.2022.03 with nicknames 2022.03]
Overview

Requirements - Day 03

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     196kb  

Part 1:

Time:   0.000ms  Memory:     223kb  Answer:  7980

Part 2:

Time:   0.000ms  Memory:     176kb  Answer:  2881
Reflections

Day 3 supplies us with random-seeming alphabetic strings and asks us to find the duplicated character in the first and second half of the string. Then we should score and sum those characters. This is easy when modeled as a set intersection of two lists of characters.

Parsing

Parsing is trivial. Just split the input by newlines. This is the default behavior of READ-DAY-INPUT so we pass IDENTITY as the callback.

(defun build-data (&optional input)
  (read-day-input #'identity :input input))

Part 1

The most annoying aspect of part 1 was the arbitrary scoring they came up with that was related to but did not quite match ASCII values. The *PRIORITIES* table deals with this and makes score lookup easy.

The SOLVE function handles the rest of the problem. It runs a preprocess-fn on the parsed input, then maps over it with SEARCH-RUCKSACK to find the duplicated character. Finally, we run the characters through TOTAL-PRIORITY for scoring. In part 1, our preprocess-fn simply splits the input lines into two halves.

(defvar *priorities*
  (let ((table (make-hash-table :test #'eq)))
    (loop for code from 65 upto 90
          do (setf (gethash (code-char code) table) (- code 38)))
    (loop for code from 97 upto 122
          do (setf (gethash (code-char code) table) (- code 96)))
    table))

(defun search-rucksack (group)
  (first (reduce #'intersection group :key (op (coerce _ 'list)))))

(defun total-priority (items)
  (reduce #'+ items :key (op (gethash _ *priorities*))))

(defun solve (data preprocess-fn)
  (~>> (funcall preprocess-fn data)
       (mapcar #'search-rucksack)
       (total-priority)))

(defun part-1 (&optional (data (build-data)))
  (solve data (op (mapcar (lambda (x) (multiple-value-list (halves x))) _))))

Part 2

Part 2 doesn't require any special handling at all. We simply call solve as we did in part-1 but with a different preprocess-fn, asking it to group things with (op (serapeum:batches _ 3)).

λ

5.4 Camp Cleanup

[in package AOC.2022.04 with nicknames 2022.04]
Overview

Requirements - Day 04

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:   6,814kb  

Part 1:

Time:   4.000ms  Memory:       0kb  Answer:  471

Part 2:

Time:   0.000ms  Memory:       0kb  Answer:  888
Reflections

Day 4 gives us a list of ranges of numbers, two to a line. We are asked to count up the lines where one range is entirely contained by another. We just need a way to determine if one range is contained by, or a subset of, another range.

Parsing

Parsing is more involved today so we break out the esrap library for PEG parsing tools. We define a parser called RANGES reusing an integer rule from my aoc.parsers.

(defvar *parser*
  (defrule ranges (and integer "-" integer "," integer "-" integer)
    (:lambda (list) (remove-if-not #'integerp list))))

(defun build-data (&optional input)
  (read-day-input (partial #'parse *parser*) :input input))

Part 1

Common Lisp's COUNT-IF function is ideal for this puzzle, accepting a callback to run on each element in the given sequence. All we need to do is write a SUBSET? check that can look at the start and end of the two ranges and determine if one is entirely contained in the other.

(defun subset? (assignment)
  (destructuring-bind (a1 a2 b1 b2) assignment
    (or (<= b1 a1 a2 b2)
        (<= a1 b1 b2 a2))))

(defun part-1 (&optional (data (build-data)))
  (count-if #'subset? data))

Part 2

Part 2 complicates things slightly by asking to detect overlapping ranges rather than subsets, but this is still simple to test for. The OVERLAP? function handles this and acts as our callback for part 2.

(defun overlap? (assignment)
  (destructuring-bind (a1 a2 b1 b2) assignment
    (or (<= a1 b1 b2 a2)
        (<= b1 a1 a2 b2)
        (<= a1 b1 a2 b2)
        (<= b1 a1 b2 a2))))

λ

5.5 Supply Stacks

[in package AOC.2022.05 with nicknames 2022.05]
Overview

Requirements - Day 05

Solution - Source on Github

Results

Input Parsing:

Time:   4.000ms  Memory:   1,837kb  

Part 1:

Time:   0.000ms  Memory:      48kb  Answer:  RTGWZTHLD

Part 2:

Time:   0.000ms  Memory:      64kb  Answer:  JCGQZRNHN
Reflections

Day 5 asks us what message is shown after performing a series of crane moves on stacks of labeled shipping containers. This is pretty simple to model with a map of integers to stacks or an array of stacks. Unfortunately, parsing the representation for the day is not so simple.

Parsing

We break out esrap again to build a robust parser for this format. We separate it into rules for the header consisting of several rows of crates, the labels for those rows, and the instructions for how to move the crane. PARSE-STACKS takes the extracted values from esrap's parse step and constructs a hash table with stacks matching the ASCII depiction in the header.

(defvar *first-rule*
  (defrule move (and "move " integer " from " integer " to " integer (? #\Newline))
    (:lambda (list)
      (remove-if-not #'integerp list))))

(defrule instructions (+ move))

(defrule crate (and "[" letter "]" whitespace)
  (:function second))

(defrule gap (and whitespace whitespace whitespace whitespace)
  (:constant :gap))

(defrule row (+ (or crate gap)))

(defrule labels (+ (or whitespace integer #\Newline))
  (:lambda (list)
    (remove-if-not #'integerp list)))

(defrule header (+ row)
  (:function first))

(defrule stacks (and header labels instructions))

(defun add-row (row table)
  (loop for i = 1 then (1+ i)
        for item in row
        when (characterp item)
          do (push item (gethash i table))))

(defun parse-stacks (input)
  (destructuring-bind (headers labels moves) (parse 'stacks input)
    (let* ((stack-count (length labels))
           (stacks (make-hash-table)))
      (loop for row in (reverse (batches headers stack-count))
            do (add-row row stacks))
      (list moves stacks))))

(defun build-data (&optional input)
  (read-day-input #'parse-stacks :whole t :input input))

Part 1

The actual work of this problem is simple. We have a list of moves to perform. We want to move a certain number of crates from stack A to stack B which is handled by MOVE-CRATES. Running all the instructions and reading the labels of the top crates on each stack is performed by INTERPRET.

(defun move-crates (count origin destination stacks)
  (dotimes (i count)
    (let ((item (pop (gethash origin stacks))))
      (push item (gethash destination stacks)))))

(defun interpret (data step-fn)
  (destructuring-bind (moves stacks) data
    (loop for (count origin destination) in moves
          do (funcall step-fn count origin destination stacks))
    (loop for i from 1 upto (hash-table-count stacks)
          collecting (first (gethash i stacks)) into chars
          finally (return (coerce chars 'string)))))

(defun part-1 (&optional (data (build-data)))
  (interpret data #'move-crates))

Part 2

Part 2 complicates matters very slightly by asking that we move the crates all at once rather than one at a time. This is handled by MOVE-CRATES-CONTIGUOUS.

(defun move-crates-contiguous (count origin destination stacks)
  (multiple-value-bind (to-move new-origin) (halves (gethash origin stacks) count)
    (setf (gethash origin stacks) new-origin
          (gethash destination stacks) (append to-move (gethash destination stacks)))))

λ

5.6 Tuning Trouble

[in package AOC.2022.06 with nicknames 2022.06]
Overview

Requirements - Day 06

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:      58kb  

Part 1:

Time:   0.000ms  Memory:     239kb  Answer:  1802

Part 2:

Time:   0.000ms  Memory:   1,247kb  Answer:  3551
Reflections

Day 6 is straightforward both in terms of parsing and logic. The input data is a single long string and we are asked to find a run of distinct characters of a certain size.

Parsing

We lean on the default READ-DAY-INPUT and IDENTITY behavior again.

Part 1

Part 1 is pretty straightforward thanks to the combination of SETP and LOOP. We loop until we find a distinct run of characters, checked for by PACKET-MARKER?, always looking back to avoid running off the end of the input.

(defun packet-marker? (input end width)
  (let ((buffer (coerce (subseq input (- end width) end) 'list)))
    (setp buffer)))

(defun find-signal-marker (input width)
  (loop for end = width then (1+ end)
        until (packet-marker? input end width)
        finally (return end)))

(defun part-1 (&optional (data (build-data)))
  (find-signal-marker data 4))

Part 2

Part 2 only asks for a different marker width which was easy to parameterize out of the original code. Pass 14 instead of 4 and we're all done.

λ

5.7 No Space Left on Device

[in package AOC.2022.07 with nicknames 2022.07]
Overview

Requirements - Day 07

Solution - Source on Github

Results

Input Parsing:

Time:   4.000ms  Memory:   5,123kb  

Part 1:

Time:   4.001ms  Memory:   1,193kb  Answer:  1077191

Part 2:

Time:  52.001ms  Memory:   8,507kb  Answer:  5649896
Reflections

Day 7 is a particularly fun problem. We're asked to read an input file with a terminal session of directory listings and determine the total space usage of directories matching some criteria. The directory names are sometimes reused at different points in the tree, so we can't cheat and just have a map from directory names to sizes, we need to model the full path and add the size of each new file to the parent dirs all the way up the tree.

Parsing

Parsing isn't too hard thanks to esrap. A few simple rules about files and distinguishing commands from output and we're ready to go.

(defvar *first-rule*
  (defrule filename (+ (or letter #\. #\/))
    (:text t)))

(defrule filespec (and integer " " filename)
  (:function first))

(defrule dir-entry (and "dir " filename)
  (:constant nil))

(defrule command (and "$ " (or "ls" "cd") (? (and " " filename)))
  (:function third)
  (:function lastcar)) ;; Ignore anything but filename

(defrule entry (or command filespec dir-entry))

(defun build-data (&optional input)
  (read-day-input (partial #'parse 'entry) :compact t :input input))

Part 1

There's a bit of a kludge here in that I use a SPECIAL variable to represent the current directory being traversed rather than passing it around all over the place. I'd like to refactor it but it works well for this use case.

(defun change-directory (entry)
  (declare (special *current-directory*))
  (if (string= ".." entry)
      (pop *current-directory*)
      (push entry *current-directory*)))

(defun count-file (entry table)
  (declare (special *current-directory*))
  (loop with directory = (copy-list *current-directory*)
        until (emptyp directory)
        do (incf (gethash directory table 0) entry)
           (pop directory)))

(defun record-entry (entry table)
  (if (stringp entry)
      (change-directory entry)
      (count-file entry table)))

(defun compute-directory-sizes (data)
  (let ((table (make-hash-table :test #'equal))
        (*current-directory* nil))
    (declare (special *current-directory*))
    (dolist (entry data)
      (record-entry entry table))
    table))

(defun total-size-matching (match-fn data)
  (~>> (compute-directory-sizes data)
       (hash-table-values)
       (remove-if-not match-fn)
       (reduce #'+)))

(defun part-1 (&optional (data (build-data)))
  (total-size-matching (op (< _ 100000)) data))

Part 2

Part 2 asks us to find the smallest directory that will free up enough space for a firmware update.

There's another kludge here in that to get a clean pipeline, I recompute the directory sizes to determine how much space needs to be freed up. Ouch!

(defun smallest-matching (match-fn data)
  (~>> (compute-directory-sizes data)
       (hash-table-values)
       (remove-if-not match-fn)
       (apply 'min)))

(defun needed-space (data)
  (~>> (compute-directory-sizes data)
       (gethash '("/"))
       (- 70000000)
       (- 30000000)))

λ

5.8 Treetop Tree House

[in package AOC.2022.08 with nicknames 2022.08]
Overview

Requirements - Day 08

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:   1,184kb  

Part 1:

Time:  24.000ms  Memory:  39,433kb  Answer:  1849

Part 2:

Time:  24.001ms  Memory:  46,863kb  Answer:  201600
Reflections

Parsing

(defun parse-row (row)
  (mapcar #'parse-integer (split "" row)))

(defun build-data (&optional input)
  (let ((data (read-day-input #'parse-row :input input)))
    (make-array (list (length data) (length data)) :initial-contents data)))

Part 1

(defun make-cardinal (row col limit direction data)
  (ecase direction
    (:south (loop for i from (1+ row) below limit collecting (aref data i col)))
    (:north (reverse (loop for i below row collecting (aref data i col))))
    (:east (loop for i from (1+ col) below limit collecting (aref data row i)))
    (:west (reverse (loop for i below col collecting (aref data row i))))))

(defun check-cardinals? (row col data limit)
  (let ((value (aref data row col)))
    (flet ((tallest? (other)
             (> value other)))
      (or (every #'tallest? (make-cardinal row col limit :south data))
          (every #'tallest? (make-cardinal row col limit :north data))
          (every #'tallest? (make-cardinal row col limit :east data))
          (every #'tallest? (make-cardinal row col limit :west data))))))

(defun visible? (row col data limit)
  (cond ((zerop row) t)
        ((zerop col) t)
        ((= limit row) t)
        ((= limit col) t)
        ((check-cardinals? row col data limit) t)
        (t nil)))

(defun count-visible? (data)
  (loop with width = (array-dimension data 0)
        for row below width
        sum (loop for col below width
                  count (visible? row col data width))))

(defun part-1 (&optional (data (build-data)))
  (count-visible? data))

Part 2

(defun scenic-score (row col limit data)
  (let ((value (aref data row col)))
    (flet ((view-distance (trees)
             (let ((blocker (position-if (op (>= _ value)) trees)))
               (or (and blocker (1+ blocker))
                   (length trees)))))
      (let ((results (mapcar (op (view-distance (make-cardinal row col limit _ data)))
                             '(:north :west :east :south))))
        (values (apply '* results) results)))))

(defun max-score (data)
  (loop with width = (array-dimension data 0)
        for row below width
        maximize (loop for col below width
                       maximize (scenic-score row col width data))))

λ

5.9 Rope Bridge

[in package AOC.2022.09 with nicknames 2022.09]
Overview

Requirements - Day 09

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:   7,255kb  

Part 1:

Time:   4.000ms  Memory:   1,050kb  Answer:  5779

Part 2:

Time:   4.001ms  Memory:   3,417kb  Answer:  2331
Reflections

Parsing

(defvar *first-rule*
  (defrule direction (or #\U #\R #\D #\L)))

(defrule motion (and direction " " integer)
  (:lambda (list) (remove " " list :test #'equal)))

(defun build-data (&optional input)
  (read-day-input (partial #'parse 'motion) :input input))

Part 1

(defun update-rope (move rope visited)
  (destructuring-bind (direction distance) move
    (dotimes (i distance)
      (setf (first rope) (move-head (first rope) direction))
      (loop for (head tail) on rope while tail
            for i = 1 then (1+ i)
            do (setf (nth i rope) (move-tail head tail))
            finally (setf (gethash head visited) t)))
    rope))

(defstruct (point (:type list)) x y)

(defun move-head (point direction)
  (case (char direction 0)
    (#\U (incf (point-y point)))
    (#\R (incf (point-x point)))
    (#\D (decf (point-y point)))
    (#\L (decf (point-x point))))
  point)

(defun move-tail (head tail)
  (let* ((new-tail (copy-list tail))
         (x-diff (- (point-x head) (point-x tail)))
         (y-diff (- (point-y head) (point-y tail)))
         (distance (floor (sqrt (+ (expt x-diff 2) (expt y-diff 2))))))
    (when (> distance 1)
      (cond ((and (> x-diff  1) (zerop y-diff)) (incf (point-x new-tail)))
            ((and (< x-diff -1) (zerop y-diff)) (decf (point-x new-tail)))
            ((and (> y-diff  1) (zerop x-diff)) (incf (point-y new-tail)))
            ((and (< y-diff -1) (zerop x-diff)) (decf (point-y new-tail)))
            ((and (plusp x-diff) (plusp y-diff))
             (incf (point-x new-tail))
             (incf (point-y new-tail)))
            ((and (minusp x-diff) (minusp y-diff))
             (decf (point-x new-tail))
             (decf (point-y new-tail)))
            ((and (plusp x-diff) (minusp y-diff))
             (incf (point-x new-tail))
             (decf (point-y new-tail)))
            ((and (minusp x-diff) (plusp y-diff))
             (decf (point-x new-tail))
             (incf (point-y new-tail)))))
    new-tail))

(defun count-visited (moves &key (tail-count 1))
  (let ((visited (make-hash-table :test #'equal))
        (rope (loop repeat (1+ tail-count) collect (make-point :x 0 :y 0))))
    (dolist (move moves)
      (update-rope move rope visited))
    (hash-table-count visited)))

(defun part-1 (&optional (data (build-data)))
  (count-visited data))

Part 2

λ

5.10 Cathode-Ray Tube

[in package AOC.2022.10 with nicknames 2022.10]
Overview

Requirements - Day 10

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     548kb  

Part 1:

Time:   4.000ms  Memory:   2,042kb  

Part 2:

Time:   0.000ms  Memory:   1,098kb  
Reflections

Parsing

(defvar *first-rule*
  (defrule opcode (or "noop" "addx")
    (:lambda (string) (make-keyword (string-upcase string)))))

(defrule args (and " " integer)
  (:function second))

(defrule instruction (and opcode (? args)))

(defun build-data (&optional input)
  (read-day-input (partial #'parse 'instruction) :input input))

Part 1

(defstruct cpu
  (cycles 0 :type fixnum)
  (x-reg 1 :type fixnum))

(defvar *cycle-times* '(:noop 1 :addx 2))

(defmethod execute :after ((cpu cpu) opcode arg)
  (incf (cpu-cycles cpu) (getf *cycle-times* opcode)))

(defmethod execute ((cpu cpu) (opcode (eql :noop)) arg))

(defmethod execute ((cpu cpu) (opcode (eql :addx)) arg)
  (incf (cpu-x-reg cpu) arg))

(defun run-program (data &key collect-fn)
  (let ((cpu (make-cpu)))
    (loop for (opcode arg) = (pop data) while opcode
          collect (funcall collect-fn cpu opcode)
          do (execute cpu opcode arg))))

(defun new-cycles (cpu opcode)
  (+ (cpu-cycles cpu) (getf *cycle-times* opcode)))

(defun sampled-cycle? (cpu opcode next-sample)
  (<= (cpu-cycles cpu) next-sample (new-cycles cpu opcode)))

(defun make-sample-fn ()
  (let ((timings '(20 60 100 140 180 220)))
    (lambda (cpu opcode)
      (when (sampled-cycle? cpu opcode (or (first timings) 0))
        (* (pop timings) (cpu-x-reg cpu))))))

(defun signal-strength (output)
  (reduce #'+ (remove nil output)))

(defun part-1 (&optional (data (build-data)))
  (signal-strength (run-program data :collect-fn (make-sample-fn))))

Part 2

(defmethod render ((cpu cpu) opcode)
  (with-slots (cycles x-reg) cpu
    (with-output-to-string (out)
      (dotimes (i (getf *cycle-times* opcode))
        (let* ((crt-pixel (mod (+ cycles i) 40))
               (active-pixel? (<= (1- x-reg) crt-pixel (1+ x-reg))))
          (format out (if active-pixel? "#" ".")))))))

(defun buffer-display (output)
  (~>> (reduce #'concat output)
       (batches _ 40)
       (string-join _ #\Newline)))

λ

5.11 Monkey in the Middle

[in package AOC.2022.11 with nicknames 2022.11]
Overview

Requirements - Day 11

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     205kb  

Part 1:

Time:   4.000ms  Memory:   1,802kb  Answer:  58322

Part 2:

Time:  76.001ms  Memory:   9,792kb  Answer:  13985281920
Reflections

Parsing

(defvar *first-rule*
  (defrule monkey-number (and "Monkey " integer ":" #\Newline)
    (:function second)))

(defrule item-list (+ (or integer ", "))
  (:lambda (list) (remove-if-not #'integerp list)))

(defrule starting-items (and spaces "Starting items: " item-list #\Newline)
  (:lambda (list) (apply 'queue (third list))))

(defrule operator (or "+" "*")
  (:function find-symbol))

(defrule inspect-op (and spaces "Operation: new = old "
                         operator " " (or integer "old") #\Newline)
  (:destructure (spaces title operator space operand newline)
    (declare (ignore spaces title space newline))
    (if (equal operand "old")
        (lambda (x) (funcall operator x x))
        (lambda (x) (funcall operator operand x)))))

(defrule test-op (and spaces "Test: divisible by " integer #\Newline)
  (:function third))

(defrule true-op (and spaces "If true: throw to monkey " integer #\Newline)
  (:function third))

(defrule false-op (and spaces "If false: throw to monkey " integer (? #\Newline))
  (:function third))

(defrule monkey (and monkey-number starting-items inspect-op
                     test-op true-op false-op (? #\Newline))
  (:destructure (num items op divisor true-fn false-fn newline)
    (declare (ignore newline))
    (make-monkey :number num :items items :operation op :divisor divisor
                 :true-recv true-fn :false-recv false-fn :inspected 0)))

(defun build-data (&optional input)
  (read-day-input (partial #'parse 'monkey) :separator "\\n\\n" :input input))

Part 1

(defstruct monkey
  number items operation divisor true-recv false-recv inspected)

(defmethod pass-item (item (monkey monkey))
  (with-slots (items) monkey
    (enq item items)))

(defmethod play-round ((monkey monkey) all-monkeys worry-fn)
  (with-slots (items operation divisor true-recv false-recv inspected) monkey
    (loop for item = (deq items) while item
          do (let ((worry-level (funcall worry-fn (funcall operation item))))
               (incf inspected)
               (if (zerop (mod worry-level divisor))
                   (pass-item worry-level (nth true-recv all-monkeys))
                   (pass-item worry-level (nth false-recv all-monkeys)))))))

(defun compute-monkey-business (monkeys)
  (~>> (mapcar #'monkey-inspected monkeys)
       (sort _ #'>)
       (subseq _ 0 2)
       (apply '*)))

(defun play (monkeys rounds worry-fn &optional (debug nil))
  (dotimes (i rounds)
    (when debug
      (format t "Starting round ~d~%" i))
    (dolist (monkey monkeys)
      (play-round monkey monkeys worry-fn)))
  (compute-monkey-business monkeys))

(defun part-1 (&optional (data (build-data)))
  (play data 20 (lambda (x) (floor x 3))))

Part 2

λ

5.12 Hill Climbing Algorithm

[in package AOC.2022.12 with nicknames 2022.12]
Overview

Requirements - Day 12

Solution - Source on Github

Results

Input Parsing:

Time:   8.000ms  Memory:   4,658kb  

Part 1:

Time:   0.000ms  Memory:     552kb  Answer:  412

Part 2:

Time:  84.002ms  Memory:  58,327kb  Answer:  402
Reflections

Parsing

(define-constant +neighbors+
    '((0 1) (0 -1) (1 0) (-1 0)) :test #'equal)

(defstruct point x y value)

(defun build-point (col row value)
  (make-point :x col :y row :value value))

(defmethod height ((point point))
  (with-slots (value) point
    (case value
      (#\S (char-code #\a))
      (#\E (char-code #\z))
      (t (char-code value)))))

(defmethod valid-step? ((point point) (match point))
  (>= 1 (- (height match)
           (height point))))

(defmethod get-neighbors ((point point) nodes)
  (with-slots (x y value) point
    (loop for (x-diff y-diff) in +neighbors+
          for coords = (cons (+ x x-diff)
                             (+ y y-diff))
          for match = (gethash coords nodes)
          when (and match (valid-step? point match))
            collect match)))

(defun parse-graph (input)
  (let ((nodes (make-hash-table :test #'equal))
        (edges (make-hash-table :test #'equal)))
    (flet ((import-row (row-idx row)
             (loop for col-idx = 0 then (1+ col-idx)
                   for char across row
                   do (let ((point (build-point col-idx row-idx char)))
                        (setf (gethash (cons col-idx row-idx) nodes) point)
                        (case char
                          (#\S (setf (gethash :start nodes) point))
                          (#\E (setf (gethash :end nodes) point)))))))
      (loop for row-idx = 0 then (1+ row-idx)
            for row in (split "\\n" input)
            do (import-row row-idx row)))
    (loop for point being the hash-values in nodes
          do (setf (gethash point edges) (get-neighbors point nodes)))
    (list nodes edges)))

(defun build-data (&optional input)
  (read-day-input #'parse-graph :whole t :input input))

Part 1

(defun ye-olde-bfs (edges root goal-fn)
  (let ((distance (make-hash-table :test #'equal))
        (to-visit (queue root)))
    (setf (gethash root distance) 0)
    (loop for node = (deq to-visit) while node
          when (funcall goal-fn node)
            return (gethash node distance)
          do (dolist (edge (gethash node edges))
               (unless (gethash edge distance)
                 (setf (gethash edge distance) (1+ (gethash node distance)))
                 (enq edge to-visit))))))

(defun part-1 (&optional (data (build-data)))
  (destructuring-bind (nodes edges) data
    (let ((destination (gethash :end nodes)))
      (ye-olde-bfs edges (gethash :start nodes) (op (eql _ destination))))))

Part 2

λ

5.13 Distress Signal

[in package AOC.2022.13 with nicknames 2022.13]
Overview

Requirements - Day 13

Solution - Source on Github

Results

Input Parsing:

Time:   4.000ms  Memory:   1,246kb  

Part 1:

Time:   4.000ms  Memory:   1,325kb  Answer:  5003

Part 2:

Time:   0.000ms  Memory:     384kb  Answer:  20280
Reflections

Parsing

(defun sanitize-packet (packet)
  (let ((replacements '(("[" "(")
                        ("]" ")")
                        ("," " "))))
    (reduce (lambda (x y) (string-replace-all (first y) x (second y)))
            replacements :initial-value packet)))

(defun parse-packets (pair)
  (let ((read-packet (compose #'read-from-string #'sanitize-packet)))
    (~>> (split "\\n" pair)
         (mapcar read-packet))))

(defun build-data (&optional input)
  (read-day-input #'parse-packets :separator "\\n\\n" :input input))

Part 1

(defgeneric compare (left right)
  (:documentation "Compare two values according to the rules of 2022.13"))

(defmethod compare ((left integer) (right integer))
  (cond ((< left right) t)
        ((> left right) nil)
        (t :equal)))

(defmethod compare ((left list) (right list))
  (dotimes (i (max (length left) (length right)))
    (when (null left) (return-from compare t))
    (when (null right) (return-from compare nil))
    (let ((result (compare (pop left) (pop right))))
      (unless (eql result :equal)
        (return-from compare result))))
  :equal)

(defmethod compare ((left list) (right integer))
  (compare left (list right)))

(defmethod compare ((left integer) (right list))
  (compare (list left) right))

(defun part-1 (&optional (data (build-data)))
  (loop for i = 0 then (1+ i)
        for (left right) in data
        when (compare left right)
          sum (1+ i)))

Part 2

λ

5.14 Regolith Reservoir

[in package AOC.2022.14 with nicknames 2022.14]
Overview

Requirements - Day 14

Solution - Source on Github

Results

Input Parsing:

Time:   4.000ms  Memory:   6,687kb  

Part 1:

Time:  12.000ms  Memory:  12,662kb  Answer:  805

Part 2:

Time: 540.013ms  Memory: 480,214kb  Answer:  25161
Reflections

Parsing

(defvar *first-rule*
  (defrule point (and integer #\, integer (? " -> "))
    (:lambda (point) (list (first point) (third point)))))

(defrule cave-path (+ point))

(defun build-data (&optional input)
  (read-day-input (partial #'parse 'cave-path) :input input))

(defun find-bounds (cave floor-mod)
  (loop for point in (hash-table-keys cave)
        minimizing (point-x point) into min-x
        maximizing (point-x point) into max-x
        minimizing (point-y point) into min-y
        maximizing (+ (point-y point) floor-mod) into max-y
        finally (return (list min-x max-x min-y max-y))))

(defstruct (point (:type list)) x y)

Part 1

(defun find-range (point1 point2)
  (let ((direction (if (= (point-x point1) (point-x point2)) :vertical :horizontal)))
    (case direction
      (:horizontal (values direction (sort (list (point-x point1) (point-x point2)) #'<)))
      (:vertical (values direction (sort (list (point-y point1) (point-y point2)) #'<))))))

(defun build-cave (data &key (floor-mod 0))
  (let ((cave (make-hash-table :test #'equal)))
    (flet ((add-segment (point1 point2)
             (multiple-value-bind (direction range) (find-range point1 point2)
               (loop for i from (first range) upto (second range)
                     do (case direction
                          (:horizontal (setf (gethash (list i (point-y point1)) cave) :rock))
                          (:vertical (setf (gethash (list (point-x point1) i) cave) :rock)))))))
      (dolist (cave-path data)
        (loop for (point1 point2) on cave-path by #'rest
              while point2 do (add-segment point1 point2)))
      (setf (gethash :bounds cave) (find-bounds cave floor-mod)))
    cave))

(defun next-position (point cave)
  (let ((options (destructuring-bind (x y) point
                   (list (make-point :x x      :y (1+ y))
                         (make-point :x (1- x) :y (1+ y))
                         (make-point :x (1+ x) :y (1+ y))))))
    (find-if-not (op (gethash _ cave)) options)))

(defun place-sand (cave &key (abyss? t))
  (loop with sand = (make-point :x 500 :y 0)
        with bottom = (lastcar (gethash :bounds cave))
        do (let ((next (next-position sand cave)))
             (cond ((null next)
                    (return (setf (gethash sand cave) :rest)))
                   ((and abyss? (> (point-y next) bottom))
                    (return :abyss))
                   ((and (null abyss?) (= (point-y next) bottom))
                    (return (setf (gethash sand cave) :rest)))
                   (t (setf sand next))))))

(defun count-sand-grains (cave &key (abyss? t))
  (loop for result = (place-sand cave :abyss? abyss?)
        until (or (eql result :abyss) (gethash '(500 0) cave)))
  (count :rest (hash-table-values cave)))

(defun part-1 (&optional (data (build-data)))
  (count-sand-grains (build-cave data)))

Part 2

(defun render (cave &key (floor :floor))
  (destructuring-bind (min-x max-x min-y max-y) (gethash :bounds cave)
    (declare (ignore min-y))
    (dotimes (y (1+ max-y))
      (loop for i from (- min-x 8) upto (+ max-x 8)
            do (let ((glyph (case (gethash (list i y) cave)
                              (:rest "o")
                              (:rock "#")
                              (t "."))))
                 (if (and (= y max-y) (eql floor :floor))
                     (format t "#")
                     (format t "~A" glyph))))
      (format t "~%"))
    (count :rest (hash-table-values cave))))

λ

6 Advent 2021

λ

6.1 Sonar Sweep

[in package AOC.2021.01 with nicknames 2021.01]
Overview

Requirements - Day 01

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     306kb  

Part 1:

Time:   0.000ms  Memory:       0kb  Answer:  1266

Part 2:

Time:   0.000ms  Memory:       0kb  Answer:  1217
Reflections

Part 1 - Into the Depths

For part 1, we'll just be checking how often a depth reading is increasing from the previous measurement. Pretty straightforward.

Part 2 - De-noising the Depths

Part 2 extends our initial solution by averaging the depth readings in a sliding window three at a time. I'm still using a straightforward loop but the partitioning of the list is ugly. Two options for improvement are:

  1. Solve the problem in two passes, first generating sums then counting increases.

  2. Factor out the size of the window, either via callback or some other means.

Interesting notes after more experiments. I've tried a number of different approaches to this problem, some that are flexible enough to accommodate both parts of the puzzle and some that are specialized to the 3-element window of the second part.

Looking at the generic versions that can account for any input size we have 3 speed tiers:

  1. COUNT-DISPLACED-DEPTHS which is depressingly slow due to use of displaced arrays. Neat feature that they are, it seems displaced arrays are just plain slow. ~5x slower.

  2. COUNT-WINDOWED-DEPTHS which uses REDUCE and LOOP to compute the result. ~2.5x-3 slower.

  3. COUNT-INCREASING-SUMS-LOOP which is a direct translation of death's solution using DO. I often enjoy reviewing death's solutions as he tends to have different ideas than I do and I think he has good taste and knowledge of the language. I don't much like DO though.

It's worth pointing out that my COUNT-WINDOWED-DEPTHS is flexible enough to accept a list or array as an input. ...Though the performance degrades substantially from ~2.5x slower to 170x slower lol. This is due to repeated traversals of the input list by reduce.

Notably, it was much easier to write a version using lists instead of arrays that conses and uses 2 passes but because it is specialized on a 3-element version, it is just as fast as the fastest generic version. Granted, I haven't tried it on larger inputs. COUNT-AVERAGE-DEPTHS is clean and simple but I was curious if I could eliminate the consing and go faster. After some experimentation, I wound up with COUNT-SHIFTING-DEPTHS which is 4-5x faster than COUNT-INCREASING-SUMS-LOOP! Very interesting to see how much of a difference specializing makes in this case.

λ

6.2 Dive!

[in package AOC.2021.02 with nicknames 2021.02]
Overview

Requirements - Day 02

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     428kb  

Part 1:

Time:   0.000ms  Memory:       0kb  Answer:  2117664

Part 2:

Time:   0.000ms  Memory:       0kb  Answer:  2073416724
Reflections

Part 1 - Plotting the Course

Part 2 - One Does Not Simply Dive

λ

6.3 Binary Diagnostic

[in package AOC.2021.03 with nicknames 2021.03]
Overview

Requirements - Day 03

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     255kb  

Part 1:

Time:   0.000ms  Memory:       0kb  Answer:  3923414

Part 2:

Time:   0.000ms  Memory:      32kb  Answer:  5852595
Reflections

Part 1 - Check the Power Consumption

Part 2 - Verify Life Support

λ

6.4 Giant Squid

[in package AOC.2021.04 with nicknames 2021.04]
Overview

Requirements - Day 04

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     130kb  

Part 1:

Time:   4.000ms  Memory:   3,311kb  Answer:  50008

Part 2:

Time:  12.001ms  Memory:   8,367kb  Answer:  9280
Reflections

Part 1 - Bingo Subsystem

Part 2 - Let the Squid Win

λ

6.5 Hydrothermal Venture

[in package AOC.2021.05 with nicknames 2021.05]
Overview

Requirements - Day 05

Solution - Source on Github

Results

Input Parsing:

Time:   4.000ms  Memory:     345kb  

Part 1:

Time:  20.000ms  Memory:  19,548kb  Answer:  4655

Part 2:

Time:  28.001ms  Memory:  37,898kb  Answer:  20500
Reflections

Part 1 - Overlapping Vents

Part 2 - Diagonal Overlap

λ

6.6 Lanternfish

[in package AOC.2021.06 with nicknames 2021.06]
Overview

Requirements - Day 06

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:      58kb  

Part 1:

Time:   0.000ms  Memory:       0kb  Answer:  360761

Part 2:

Time:   0.000ms  Memory:       0kb  Answer:  1734242933190511
Reflections

Part 1 - That's a big school

Part 2 - Uh oh

λ

6.7 The Treachery of Whales

[in package AOC.2021.07 with nicknames 2021.07]
Overview

Requirements - Day 07

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     166kb  

Part 1:

Time:   0.000ms  Memory:       0kb  Answer:  356922

Part 2:

Time:   0.000ms  Memory:       0kb  Answer:  100347031
Reflections

Part 1 - Do the Crab Claw

Part 2 - Crabs Engineer Different

λ

6.8 Seven Segment Search

[in package AOC.2021.08 with nicknames 2021.08]
Overview

Requirements - Day 08

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     628kb  

Part 1:

Time:   0.000ms  Memory:       0kb  Answer:  493

Part 2:

Time:   4.000ms  Memory:     223kb  Answer:  1010460
Reflections

Part 1 - Count the Easy Ones

Part 2 - Decode the Outputs

λ

6.9 Smoke Basin

[in package AOC.2021.09 with nicknames 2021.09]
Overview

Requirements - Day 09

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     251kb  

Part 1:

Time:   0.000ms  Memory:   1,711kb  Answer:  436

Part 2:

Time:  32.001ms  Memory:  17,674kb  Answer:  1317792
Reflections

Part 1 - Follow the Smoke

Part 2 - Dodge the Basins

λ

6.10 Syntax Scoring

[in package AOC.2021.10 with nicknames 2021.10]
Overview

Requirements - Day 10

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     173kb  

Part 1:

Time:   0.000ms  Memory:      80kb  Answer:  392421

Part 2:

Time:   0.000ms  Memory:     144kb  Answer:  2769449099
Reflections

λ

6.11 Dumbo Octopuses

[in package AOC.2021.11 with nicknames 2021.11]
Overview

Requirements - Day 11

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:      13kb  

Part 1:

Time:   0.000ms  Memory:     831kb  Answer:  1673

Part 2:

Time:   4.000ms  Memory:   1,391kb  Answer:  179
Reflections

λ

7 Advent 2020

λ

7.1 Report Repair

[in package AOC.2020.01 with nicknames 2020.01]
Overview

Requirements - Day 01

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:      49kb  

Part 1:

Time:   0.000ms  Memory:       0kb  Answer:  910539

Part 2:

Time:   0.000ms  Memory:      31kb  Answer:  116724144
Reflections

Part 1 - Fix the Expense Report

Part 2 - Now in triplicate

λ

7.2 Password Philosophy

[in package AOC.2020.02 with nicknames 2020.02]
Overview

Requirements - Day 02

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     749kb  

Part 1:

Time:   0.000ms  Memory:     384kb  Answer:  456

Part 2:

Time:   0.000ms  Memory:       0kb  Answer:  308
Reflections

Part 1 - Count valid passwords

Part 2 - Count using XOR

λ

7.3 Toboggan Trajectory

[in package AOC.2020.03 with nicknames 2020.03]
Overview

Requirements - Day 03

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     186kb  

Part 1:

Time:   0.000ms  Memory:       0kb  Answer:  274

Part 2:

Time:   0.000ms  Memory:       0kb  Answer:  6050183040
Reflections

Part 1 - Count tree collisions

Part 2 - Count multiple slopes

λ

7.4 Passport Processing

[in package AOC.2020.04 with nicknames 2020.04]
Overview

Requirements - Day 04

Solution - Source on Github

Results

Input Parsing:

Time:   4.000ms  Memory:   2,763kb  

Part 1:

Time:   0.000ms  Memory:      32kb  Answer:  256

Part 2:

Time:   0.000ms  Memory:      47kb  Answer:  199
Reflections

Part 1 - Check required fields

Part 2 - Validate fields

λ

7.5 Binary Boarding

[in package AOC.2020.05 with nicknames 2020.05]
Overview

Requirements - Day 05

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     235kb  

Part 1:

Time:   4.000ms  Memory:      63kb  Answer:  880

Part 2:

Time:   0.000ms  Memory:     148kb  Answer:  731
Reflections

Part 1 - Binary Seat Encoding

Part 2 - Find the unoccupied seat

λ

7.6 Custom Customs

[in package AOC.2020.06 with nicknames 2020.06]
Overview

Requirements - Day 06

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     749kb  

Part 1:

Time:   4.000ms  Memory:      80kb  Answer:  6726

Part 2:

Time:   0.000ms  Memory:     128kb  Answer:  3316
Reflections

Part 1 - Count any yes answers

Part 2 - Count all yes answers

λ

7.7 Handy Haversacks

[in package AOC.2020.07 with nicknames 2020.07]
Overview

Requirements - Day 07

Solution - Source on Github

Results

Input Parsing:

Time:   4.000ms  Memory:   1,730kb  

Part 1:

Time:   4.000ms  Memory:      77kb  Answer:  151

Part 2:

Time:   0.000ms  Memory:      52kb  Answer:  41559
Reflections

Part 1 - How many bags can contain a shiny gold bag?

Part 2 - How many bags does a shiny gold bag hold?

λ

7.8 Handheld Halt

[in package AOC.2020.08 with nicknames 2020.08]
Overview

Requirements - Day 08

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     277kb  

Part 1:

Time:   0.000ms  Memory:      15kb  Answer:  1801

Part 2:

Time:   8.000ms  Memory:   7,078kb  Answer:  2060
Reflections

Part 1 - Find the bootloader error

Part 2 - Fix the bootloader error

λ

7.9 Encoding Error

[in package AOC.2020.09 with nicknames 2020.09]
Overview

Requirements - Day 09

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:     229kb  

Part 1:

Time: 216.005ms  Memory: 156,411kb  Answer:  3199139634

Part 2:

Time: 1064.023ms  Memory: 372,577kb  Answer:  438559930
Reflections

Part 1 - Find vulnerable number

Part 2 - Break the encryption

λ

8 Advent 2019

λ

8.1 The Tyranny of the Rocket Equation

[in package AOC.2019.01 with nicknames 2019.01]
Overview

Requirements - Day 01

Solution - Source on Github

Results

Input Parsing:

Time:   0.000ms  Memory:      10kb  

Part 1:

Time:   0.000ms  Memory:       0kb  Answer:  3282935

Part 2:

Time:   0.000ms  Memory:       0kb  Answer:  4921542
Reflections

Part 1 - Fuel for Modules

Part 1 is just a simple summation problem. We need to compute the total fuel requirements based on a list of masses provided. To make things a little interesting I wrote three variations, one with REDUCE, one with DOLIST, and one with LOOP. The different versions were almost equivalent, taking ~10k CPU cycles and executing in a handful of microseconds. I added a type declaration to the LOOP version for giggles and saw a ~50% speedup which is reflected in the disassembly being a tighter 124 bytes compared to 276 bytes for the DOLIST version and 371 bytes for the functional version.

(let ((data (read-day-input #'parse-integer)))
  (time (fuel-requirements-3 data)))

;; Evaluation took:
;;   0.000 seconds of real time
;;   0.000002 seconds of total run time (0.000002 user, 0.000000 system)
;;   100.00% CPU
;;   4,426 processor cycles
;;   0 bytes consed

Part 2 - Fuel for Fuel

To extend the problem, we'll compute a fixed point for the fuel. Similar to the first part, I wrote a few different variations on this problem. The first was a classic tail recursive approach and the second used nested LOOPs.

Two interesting notes:

(let ((data (read-day-input #'parse-integer)))
  (time (total-fuel-needed-2 data)))

;; Evaluation took:
;;   0.000 seconds of real time
;;   0.000018 seconds of total run time (0.000017 user, 0.000001 system)
;;   100.00% CPU
;;   42,426 processor cycles
;;   0 bytes consed