# Imports / Utilities

(use-modules
 ;; receive form
 (srfi srfi-8)
 ;; structs
 (srfi srfi-9)
 ;; for functional structs (not part of srfi-9 directly)
 (srfi srfi-9 gnu)
 ;; cut
 (srfi srfi-26)
 ;; integers as bits
 (srfi srfi-60)
 ;; hash tables
 (srfi srfi-69)
 (ice-9 pretty-print)
 ;; custom libs
 (aoc2024 fileio)
 (aoc2024 pipeline)
 (aoc2024 list-utils)
 (aoc2024 array-utils)
 (aoc2024 bit-integers)
 (aoc2024 timing))

Some quality of life improvements here:

• The receive form from srfi-8, for receiving multiple values.
• Since we want to do FP, we are also using functional structs from srfi-9 additions of GNU Guile.
• The cut macro from srfi-26, which is one of my favorites, and gets probably as close to currying as possible in Scheme.
• srfi-60 helps us in treating integers as sequences of bits.
• srfi-69 using SRFI hash tables, instead of built-in hash tables, for better portability, in the imaginary case of ever porting the code to another Scheme dialect.
• pretty-print as the name indicates, for pretty printing things.
• Anything starting with aoc2024 is my own utility modules, accumulated useful functions from previous Advent of Code puzzles of 2024 and earlier:
  • fileio for reading files in one function call.
  • pipeline for a pipeline/threading macro ->, which makes code more readable and elegant.
  • list-utils more list functions.
  • array-utils array helper functions.
  • bit-integers helper functions for treating integers as bits or bits as integers.
  • timing helper functions for timing function calls, to see what performs how well.

With that, we are ready to get started.

# Puzzle input

The example input looks like this:

##########
#..O..O.O#
#......O.#
#.OO..O.O#
#..O@..O.#
#O#..O...#
#O..O..O.#
#.OO.O.OO#
#....O...#
##########

<vv>^<v^>v>^vv^v>v<>v^v<v<^vv<<<^><<><>>v<vvv<>^v^>^<<<><<v<<<v^vv^v>^
vvv<<^>^v^^><<>>><>^<<><^vv^^<>vvv<>><^^v>^>vv<>v<<<<v<^v>^<^^>>>^<v<v
><>vv>v^v^<>><>>>><^^>vv>v<^^^>>v^v^<^^>v^^>v^<^v>v<>>v^v^<v>v^^<^^vv<
<<v<^>>^^^^>>>v^<>vvv^><v<<<>^^^vv^<vvv>^>v<^^^^v<>^>vvvv><>>v^<<^^^^^
^><^><>>><>^^<<^^v>>><^<v>^<vv>>v>>>^v><>^v><<<<v>>v<v<v>vvv>^<><<>^><
^>><>^v<><^vvv<^^<><v<<<<<><^v<<<><<<^^<v<^^^><^>>^<v^><<<^>>^v<v^v<v^
>^>>^v>vv>^<<^v<>><<><<v<<v><>v<^vv<<<>^^v^>^^>>><<^v>>v^v><^^>>^<>vv^
<><^^>^^^<><vvvvv^v<v<<>^v<v>v<<^><<><<><<<^^<<<^<<>><<><^^^>^^<>^>v<>
^^>vv<^v^v<vv>^<><v<^v>^^^>>>^^vvv^>vvv<>>>^<^>>>>>^<<^v>^vvv<>^<><<v>
v^^>>><<^^<>>^v^<v^vv<>v^<<>^<^v^v><^<<<><<^<v><v<>vv>>v><v^<vv<>v^<<^

So there are 2 things in the input. The warehouse:

• wall: #
• box: O
• robot: @
• empty space: .

and the robot movements:

• right: >
• left: <
• up: ^
• down: v

We want to process them separately, so lets go ahead and get the warehouse data and the movements into separate data structures:

(define-values (field-strings inputs)
  (receive (field inputs)
      (split-at (get-lines-from-file "input")
                (λ (line) (string-null? line)))
    (values field
            (-> (string-join inputs "")
                string-trim-right
                string->list))))

Using define-values, we define 2 values, the field, which is the warehouse state, and inputs which are the robot movements. We use receive to get the whole input file split-at the empty string, which satisfies the predicate string-null? and we make use of get-lines-from-file, which is from my helper module fileio. With field and inputs defined, we employ ->, the pipeline macro from my pipeline helper module, to string-join the lines of the robot movement input and string-trim-right, to get one long string of robot movements and then turn that into a list of characters using string->list.

Remember how I said mutable 2d-arrays are out of the window? Well, not totally. We can still use them, but only if we don't mutate them. What we do next is:

(define grid (-> field-strings
                 (map string->list)
                 (list->array 2)))
(define rows (array-len-in-dim grid 0))
(define cols (array-len-in-dim grid 1))

# Bitboard creation

We convert the list of strings that are the warehouse state into a nested list of characters, by mapping each line with string->list and then turning the nested list into an array using list->array. Then it is trivial to store the number of rows and cols by getting array lengths in dimension 0 and 1. The result will be a 2d-array containing characters representing the warehouse state (., #, O, @).

Having the state as an array allows for accessing in constant O(1) runtime. We iterate over this array and create bitboards, without needing any mutation of the array. Here is the function, that we use for that:

(define grid->bit-integer
  (λ (grid pred indices->position)
    "Create a bit integer from the given array GRID, which has
bits set in all positions for which the corresponding value
of ARR satisfies PRED.

Assumes that GRID is a 2d-array."
    (let* ([shape (list->vector (array-shape grid))]
           [max-dim (- (vector-length shape) 1)])
      (let iter ([result° 0] [indices° #(0 0)])
        (cond
         [indices°
          (let ([position (indices->position indices°)]
                [next-index (array-next-index shape indices° max-dim)])
            (cond
             [(pred (array-cell-ref-vec grid indices°) indices°)
              (iter (set-bit-at-pos result° position) next-index)]
             [else
              (iter result° next-index)]))]
         [else
          result°])))))

The function grid->bit-integer takes the following arguments:

1. grid, a 2d-array
2. a predicate pred, whose boolean return value determines at which positions in the bitboard are 1s and 0s.
3. a function indices->position for translating indices of the array into corresponding "positions" in the bitboard.

grid->bit-integer uses a named let and recursion to iterate through the array. array-next-index is a helper function, that returns the next vector of indices into the array, based on the array shape the previous indices and maximum dimension of the array. This is very convenient, because grid->bit-integer does not itself need to contain any logic for determining the next indices.

In the recursive call (iter (set-bit-at-pos result° position) next-index) set-bit-at-pos is used to functionally update the bitboard result°. result° is never mutated. Instead the new version of it is passed in the recursive call, together with the next array indices next-index.

We need an actual implementation for the functions for converting from row and column indices to positions in the bitboard, which will be used as indices->position argument to grid->bit-integer. To keep things simple, we are sticking to typical row-major order of indices:

(define row-major-2d-indices->position
  (λ (inds)
    "Convert indices of row-major order into a position of the
corresponding bit in a bitmap, mapping lowest indices to the
least significant bits."
    (let ([row (vector-ref inds 0)]
          [col (vector-ref inds 1)]
          [max-pos (- (* rows cols) 1)])
      (- max-pos
         (+ (* row cols) col)))))

This means the first index will be the row ("row-major"), and the second index will be the column. Also we define the reverse function, that returns the indices, given a position in the bitboard:

(define position->row-major-2d-indices
  (λ (pos)
    (receive (r c) (euclidean/ pos cols)
      ;; The higher the position, the further left (most
      ;; significant bit) in the integer we go. A higher
      ;; position should be a lower row index and a lower
      ;; position should be a higher row index, visually
      ;; further down.

      ;; Same goes for columns. A higher position must be
      ;; further left, so we substract from the number of
      ;; available columns.
      (vector (- rows r 1)
              (- cols c 1)))))

In order to refer to characters for walls (blockers), boxes (crates), the robot, and empty spaces more readably, we also define the following:

(define empty-space-char #\.)
(define crate-char #\O)
(define blocker-char #\#)
(define robot-char #\@)

Then we are ready to define the bitboards as follows:

(define robot-bitmap
  (grid->bit-integer grid
                     (λ (elem _indices) (char=? elem robot-char))
                     row-major-2d-indices->position))

(define crates-bitmap
  (grid->bit-integer grid
                     (λ (elem _indices) (char=? elem crate-char))
                     row-major-2d-indices->position))

(define blockers-bitmap
  (grid->bit-integer grid
                     (λ (elem _indices) (char=? elem blocker-char))
                     row-major-2d-indices->position))

# Displaying bitboards

It also makes sense to have a procedure for displaying bitboards in a readable way, as grid, instead of one long sequence of bits:

(define display-bitmap-ex
  (lambda* (bitmap #:key (translate id))
    (display-bitmap bitmap
                    (* rows cols)
                    cols
                    #:translate translate)))

display-bitmap-ex is named -ex because it extends an existing display-bitmap function of the bit-integers module. It provides a simpler interface, relying on rows and cols being defined in the module that display-bitmap-ex is defined in. It also makes use of the identity function id:

(define id (λ (x) x))

For displaying bitboards properly, it would be good to not merely display 0s and 1s, but the actual characters, which we know from the puzzle description, as well. For this purpose we define a few translation functions:

(define crates-translate-bits
  (λ (elem row-ind col-ind)
    (cond
     ;; optional conditions
     [(= row-ind 0) blocker-char]
     [(= row-ind (- rows 1)) blocker-char]
     [(= col-ind 0) blocker-char]
     [(= col-ind (- cols 1)) blocker-char]
     ;; mandatory conditions for correct display
     [(= elem 0) empty-space-char]
     [(= elem 1) crate-char]
     [else elem])))

(define blockers-translate-bits
  (λ (elem row-ind col-ind)
    (cond
     [(= elem 0) empty-space-char]
     [(= elem 1) blocker-char]
     [else elem])))

(define robot-translate-bits
  (λ (elem row-ind col-ind)
    (cond
     [(= elem 0) empty-space-char]
     [(= elem 1) robot-char]
     [else elem])))

These will be used by display-bitmap-ex, for the keyword argument translate.

Lets see how our bitboards look for the initial warehouse state. The example puzzle input for the warehouse looks like this:

##########
#..O..O.O#
#......O.#
#.OO..O.O#
#..O@..O.#
#O#..O...#
#O..O..O.#
#.OO.O.OO#
#....O...#
##########

10 rows, 10 columns, a 10x10 grid from which we derive the following bitboards:

1. Walls bitboard:

INPUT:      WALLS:      BOXES:      EMPTY:
##########  1111111111  0000000000  0000000000
#..O..O.O#  1000000001  0001001010  0110110100
#......O.#  1000000001  0000000100  0111111010
#.OO..O.O#  1000000001  0011001010  0100110100
#..O@..O.#  1000000001  0001000100  0110011010
#O#..O...#  1010000001  0100010000  0001101110
#O..O..O.#  1000000001  0100100100  0011011010
#.OO.O.OO#  1000000001  0011010110  0100101000
#....O...#  1000000001  0000010000  0111101110
##########  1111111111  0000000000  0000000000

The bitboards are bigger than the ones of a chess board, but that shall not stop us.

# Get relative positions

Readability is key, and since the robot movement simulation will move the robot in any of the 4 directions often, and we need to refer to movements in the code, we also create functions for determining the positions of the bits in the bitboards, that are 1 move up, down, left, or right of any given position, for better readability:

(define pos-relative-up (λ (pos) (+ pos cols)))
(define pos-relative-down (λ (pos) (- pos cols)))
(define pos-relative-left (λ (pos) (+ pos 1)))
(define pos-relative-right (λ (pos) (- pos 1)))

Actually, defining all these little functions, what we are doing is building an abstraction layer around the low level details of bitboards. When we calculate the position to the right of some position in the bitboard, we could be at the right edge and then there is no position that should be considered "right" of the current position. Considering this, the above defined functions for determining the positions up, down, left, right relative to the current position are naive. What we actually need are functions, that will not return a bogus position, but will indicate, when there is no position in a specific direction. These are defined as follows:

(define pos-relative-up-safe
  (λ (pos)
    (let ([up (pos-relative-up pos)])
      (if (and (same-col? pos up) (not (negative? up)))
          up
          #f))))

(define pos-relative-down-safe
  (λ (pos)
    (let ([down (pos-relative-down pos)])
      (if (and (same-col? pos down)
               (< (receive (q r) (euclidean/ down cols) q)
                  rows))
          down
          #f))))

(define pos-relative-left-safe
  (λ (pos)
    (let ([left (pos-relative-left pos)])
      (if (and (same-row? pos left) (not (negative? left)))
          left
          #f))))

(define pos-relative-right-safe
  (λ (pos)
    (let ([right (pos-relative-right pos)])
      (if (and (same-row? pos right))
          right
          #f))))

These will return the position in the specific direction or #f, if there is no such position.

# Find robot position

To determine the robot starting position, we do the following:

(define robot? (λ (elem) (char=? elem robot-char)))

(define robot-start-pos
  (row-major-2d-indices->position
   (array-index-of grid robot?)))

array-index-of is a helper function from my array-utils module, which returns the first indices, where the predicate robot? is satisfied.

# Find empty spaces for movement of boxes

The description of the puzzle states, that a box can only be moved, if there is no wall in that direction, or other boxes, which are themselves blocked by a wall in that direction. There needs to be some empty space, behind the box(es) so that they can be moved. To determine whether such an empty space exists we will need a function:

(define find-empty-space-in-direction
  (λ (robot-pos direction crates-bitmap blockers-bitmap)
    "Look for an empty space moving from the ROBOT-POS in the
given DIRECTION.

DIRECTION is expected to be a function that given a position
returns the next position relative to the one given safely.
Safely meaning that it will return false, if the next
position would be out of bounds."
    (let ([empty-space-bitmap
           (bitwise-not
            (bitwise-ior crates-bitmap blockers-bitmap))])
      (let iter ([next-pos (direction robot-pos)])
        (cond
         [next-pos
          (cond
           ;; Empty space found? Then a move in the
           ;; direction is possible.
           [(= (get-bit-value-at-pos empty-space-bitmap next-pos) 1)
            next-pos]
           ;; Is there a blocker at the position? Then no
           ;; move in the direction is possible.
           [(= (get-bit-value-at-pos blockers-bitmap next-pos) 1)
            #f]
           ;; Otherwise there is a crate at the position
           ;; and we need to check the next position.
           [else (iter (direction next-pos))])]
         [else #f])))))

find-empty-space-in-direction takes the position of the robot, robot-pos, the direction in which the boxes shall be moved, which is one of pos-relative-up-safe, pos-relative-down-safe, pos-relative-left-safe, and pos-relative-right-safe, the bitboard of boxes crates-bitmap and the bitboard of walls blockers-bitmap. It returns #f, if there is no empty space in the specified direction.

We also define a few predicates to check whether there is a box, a wall or nothing at a given bitboard position:

(define crate-at-position?
  (λ (pos crates-bitmap)
    (= (get-bit-value-at-pos crates-bitmap pos) 1)))

(define blocker-at-position?
  (λ (pos blockers-bitmap)
    (= (get-bit-value-at-pos blockers-bitmap pos) 1)))

(define empty-at-position?
  (λ (pos crates-bitmap blockers-bitmap)
    (= (get-bit-value-at-pos (bitwise-ior blockers-bitmap crates-bitmap)
                             pos)
       0)))

These simply take the corresponding bitboard and the position and use bitboard helper functions to check the condition.

# Moving boxes

We will need to also have a function for actually "moving" a box/crate to simulate the robot movements:

(define move-crate
  (λ (pos-old pos-new crates-bitmap)
    (-> crates-bitmap
        ((cut unset-bit-at-pos <> pos-old))
        ((cut set-bit-at-pos <> pos-new)))))

And a function for moving the robot, which checks for walls and whether boxes/crates can be moved, so that a robot movement can be executed, or if it cannot, be ignored/skipped:

(define move
  (λ (robot-pos direction crates-bitmap blockers-bitmap)
    "Move the robot into a given DIRECTION, if possible."
    (let ([next-pos (direction robot-pos)])
      (cond
       [(blocker-at-position? next-pos blockers-bitmap)
        (values robot-pos crates-bitmap)]
       ;; If the next position is empty, then simply go
       ;; there. Crates stay the same.
       [(empty-at-position? next-pos crates-bitmap blockers-bitmap)
        (values next-pos crates-bitmap)]
       ;; If there is a crate, move it to the next free
       ;; spot, by calculating a new crates-bitmap.
       [else
        (let ([next-free-pos
               (find-empty-space-in-direction robot-pos
                                              direction
                                              crates-bitmap
                                              blockers-bitmap)])
          (cond
           ;; If there is a next free position in that
           ;; direction, then we move the crate there and
           ;; move the robot to where the crate was.
           [next-free-pos
            (values next-pos
                    (move-crate next-pos
                                next-free-pos
                                crates-bitmap))]
           ;; Otherwise do not change anything.
           [else (values robot-pos crates-bitmap)]))]))))

move takes as arguments:

1. the robot position in the bitboards robot-pos
2. the direction in which to move according to the movement instructions found in the puzzle input
3. the bitboard containing the information about the boxes/crates crates-bitmap
4. the bitboard containing the information about the walls/blockers blockers-bitmap

The direction is actually a function, not one of the direction indicating characters ^, v, <, >. To call move we still need to translate from those characters of the puzzle input, to the actual direction functions. We do this as follows:

(define direction-table
  (alist->hash-table
   `((#\^ . ,pos-relative-up-safe)
     (#\v . ,pos-relative-down-safe)
     (#\< . ,pos-relative-left-safe)
     (#\> . ,pos-relative-right-safe))))

(define move-char->direction
  (λ (char)
    (hash-table-ref direction-table char)))

We use a non-functional hash table, but just like we did with the array initially, we only initialize the hash table, and then perform only lookups. We never mutate it. This usage is acceptable, when trying to stay in the realm of functional programming.

# Calculating a score

Since the puzzle requires to calculate a sum of weighted coordinates of box positions, we also need to implement that. We do this using the score function, which we define as follows:

(define score
  (λ (crates-bitmap)
    (simple-format #t "calculate score of crates:\n")
    (display-bitmap-ex crates-bitmap
                       #:translate crates-translate-bits)
    (let ([max-pos (- (* rows cols) 1)])
      (let iter-pos ([pos° 0] [result° 0])
        (cond
         [(<= pos° max-pos)
          (let ([val (get-bit-value-at-pos crates-bitmap pos°)])
            (cond
             [(= val 1)
              (let* ([indices (position->row-major-2d-indices pos°)]
                     [row-ind (vector-ref indices 0)]
                     [col-ind (vector-ref indices 1)])
                (iter-pos (+ pos° 1)
                          (+ result°
                             (+ (* row-ind 100)
                                col-ind))))]
             [else (iter-pos (+ pos° 1)
                             result°)]))]
         [else result°])))))

This score function iterates through the crates-bitmap, and calculates the weighted coordinates for each of the boxes. Looks a bit verbose still, and could probably be split up, refactored a bit.

To be able to calculate the score using score, the last thing we need to do is to actually simulate the robot movements, iterating through the robot movement inputs. When the last movement is processed, we will have the final position of all the boxes, and can run score. The result will be the solution of the puzzle. Here is how we do it:

(define solution
  (-> (let iter-inputs ([robot-pos° robot-start-pos]
                        [inputs° inputs]
                        [crates-bitmap° crates-bitmap])
        (cond
         [(null? inputs°)
          (simple-format
           #t "robot at: ~s\n"
           (position->row-major-2d-indices robot-pos°))
          (simple-format #t "grid of crates:\n")
          (display-bitmap-ex crates-bitmap°
                             #:translate crates-translate-bits)
          crates-bitmap°]
         [else
          (let ([direction (move-char->direction (car inputs°))])
            (receive (next-robot-pos next-crates-bitmap)
                (move robot-pos°
                      direction
                      crates-bitmap°
                      blockers-bitmap)
              (iter-inputs next-robot-pos
                           (cdr inputs°)
                           next-crates-bitmap)))]))
      score))

(simple-format #t "score: ~s\n" solution)