Today I'll be using Scheme, a very clean Lisp dialect with something
of a functional programming focus. The biggest difference between
traditional Lisps and Scheme is that Scheme tends to use functions a
lot more, eg instead of a with-open-file macro, you just pass
with-input-from-file or similar a function that it calls in the
appropriate context. Functions and variables share the same namespace,
which is clean semantically, but a little awkward in practice (I like
being able to name a variable list without shadowing the list
function). The language is much more barebones out of the box, but
easily extensible. I find Common Lisp a lot more fun, but Scheme has
an easier learning curve, I think.
Scheme implementations are fairly diverse, but I'll be using GNU Guile 2 for this. It's a well-supported, full-featured, free software implementation that's been improving a lot as time goes on.
For this challenge, we need to parse a description of a filesystem layout, compact the layout, and then compute a checksum:
123, our disk looks like
0..111, and we want to arrange it into 0111...0111.. example is 0*0 + 1*1 + 1*2 + 1*3.We can use Guile's support for R6RS (a newer Scheme standard)'s IO
functions with (use-modules (rnrs io ports)) to allow us access to
the get-line function, which we can combine with
with-input-from-file to read a line. with-input-from-file takes a
filename and a function and calls the function with the opened file
bound to standard input:
(use-modules (rnrs io ports))
(define (read-disk)
(with-input-from-file "2024/input/day-09.txt"
(lambda ()
(get-line (current-input-port)))))
Once we have a line, we can loop over it to sum the digits to get a
total number of blocks in the disk, and allocate a vector of that
size, then loop over the list again to populate the vector. In our
implementation, we use Scheme's "named let" feature a few times: it's
similar to regular let, but before the bindings it takes a bare
symbol; the given bindings are the initial values, and the name can be
called as a function with its arguments used as new values of the
bindings in the next iteration.
(define (make-disk diskmap)
(define (digit-at i)
(string->number (string (string-ref diskmap i))))
(define (disk-size)
(let loop ((i 0)
(size 0))
(if (>= i (string-length diskmap)) size
(loop (+ i 1) (+ size (digit-at i))))))
(let ((result (make-vector (disk-size))))
(let loop ((i 0)
(offset 0)
(file-id 0))
(dotimes (j (digit-at i))
(vector-set! result (+ offset i j) file-id))
(let ((new-i (+ i 2))
(new-offset (+ offset
(digit-at i)
(if (>= (+ i 1) (string-length diskmap)) 0
(digit-at (+ i 1))))))
(if (>= new-i (string-length diskmap)) result
(loop new-i new-offset (+ file-id 1)))))))
We also use dotimes, which is a simple macro copied from Common Lisp
for repeating a body a given number of times. Guile supports the
traditional Lisp defmacro, but in the name of being a little
Schemier, let's define it using Scheme's declarative, hygienic macro
system with define-syntax and syntax-rules. The macro system being
hygienic means that we don't need to worry about using names that the
calling code might also be using and having them clash, or us needing
to manage gensyms:
(define-syntax dotimes
(syntax-rules ()
((_ (var times) body ...) ; the pattern
(let loop ((var 0)) ; the expansion
(while (< var times)
body ...
(set! var (+ var 1)))))))
Now that we can read and expand a diskmap, we can write a
compact-disk! function for compacting it. Bangs at the end of
function names in Scheme indicate that they mutate state. We'll want
to keep left and right pointers so that we don't need to keep scanning
from the ends to find the first open/occupied block, and the loop
should end once they pass each other or meet. Easy as pie, especially
with a few more private functions to help:
(define (compact-disk! disk)
(define (next-left left)
(let loop ((new-left left))
(if (or (>= new-left (vector-length disk))
(unspecified? (vector-ref disk new-left)))
new-left
(loop (+ new-left 1)))))
(define (next-right right)
(let loop ((new-right right))
(if (or (negative? new-right)
(not (unspecified? (vector-ref disk new-right))))
new-right
(loop (- new-right 1)))))
(define (swap i j)
(let ((temp (vector-ref disk i)))
(vector-set! disk i (vector-ref disk j))
(vector-set! disk j temp)))
(let loop ((left (next-left 0))
(right (next-right (- (vector-length disk) 1))))
(if (<= right left) disk
(begin (swap left right)
(loop (next-left left) (next-right right))))))
begin simply allows us to run several forms where one is expected,
returning the result of the last one. In other Lisps, it's often known
as progn.
Computing the checksum doesn't present any challenges:
(define (disk-checksum disk)
(let loop ((i 0)
(checksum 0))
(if (or (>= i (vector-length disk))
(unspecified? (vector-ref disk i)))
checksum
(loop (+ i 1) (+ checksum (* i (vector-ref disk i)))))))
Now we can put it all together and it works:
(let ((disk (make-disk (read-disk))))
(compact-disk! disk)
(display (disk-checksum disk))
(newline))
For the second task, we need to modify how disk compression works to keep files in one piece. We start at the highest file ID and work our way down, trying to move each one exactly once to the leftmost space that's large enough to fit it. If we can't move a file, it just stays where it is.
compact-disk! needs to be rewritten entirely. There's no persistent
left pointer to manage anymore, and to adjust the right pointer, we
now need to scan until we reach a different value that isn't
#<unspecified>. We can use the file-index becoming negative as an
end condition, and use helper functions to handle stepping finding the
next file and the next free block. The only new feature we'll use is
cond, which handles multi-way conditional branches. It has the
syntax (cond (pred body) ...), and a default clause can be provided
at the end with (else body). In order to clear elements from the
vector after moving them, we define an unspecified value using an
empty begin block.
(define (compact-disk! disk)
(define (first-file-index)
(let loop ((file-index (- (vector-length disk) 1)))
(if (unspecified? (vector-ref disk file-index))
(loop (- file-index 1))
file-index)))
(define (next-file-index file-index)
(let loop ((new-file-index file-index))
(if (negative? new-file-index) new-file-index
(let ((initial (vector-ref disk file-index))
(element (vector-ref disk new-file-index)))
(if (or (equal? element initial)
(unspecified? element))
(loop (- new-file-index 1))
new-file-index)))))
(define (try-move-file file-index)
(let* ((width (file-width file-index))
(block (find-block width))
(source (+ (- file-index width) 1)))
(if (and block
(not (negative? source))
(> source block))
(move-file source block width))))
(define (file-width file-index)
(let ((initial (vector-ref disk file-index)))
(let loop ((i file-index)
(size 0))
(if (and (not (negative? i))
(equal? (vector-ref disk i) initial))
(loop (- i 1) (+ size 1))
size))))
(define (find-block size)
(let loop ((i 0)
(current-size 0))
(if (>= i (vector-length disk)) #f
(cond ((equal? size current-size)
(- i size))
((unspecified? (vector-ref disk i))
(loop (+ i 1) (+ current-size 1)))
(else
(loop (+ i 1) 0))))))
(define unspecified (begin))
(define (move-file source target length)
(dotimes (i length)
(vector-set! disk (+ target i)
(vector-ref disk (+ source i)))
(vector-set! disk (+ source i)
unspecified)))
(let loop ((file-index (first-file-index)))
(if (negative? file-index) disk
(begin (try-move-file file-index)
(loop (next-file-index file-index))))))
Since there might be gaps between files, we'll need to modify our
checksum code to ignore #<unspecified> cells in the disk vector:
(define (disk-checksum disk)
(let loop ((i 0)
(checksum 0))
(cond ((>= i (vector-length disk))
checksum)
((unspecified? (vector-ref disk i))
(loop (+ i 1) checksum))
(else
(loop (+ i 1) (+ checksum (* i (vector-ref disk i))))))))