Hello all!
Thread to post Advent of Code solutions and discussions around them. For day 1 I am pretty happy with most of my solution, except that I have this function:
(define field-size 100)
(define (zero-crossings initial-position delta)
(+
(- (abs (quotient (+ initial-position delta) field-size))
(abs (quotient initial-position field-size)))
(if (or
(= initial-position 0)
(= (sgn initial-position) (sgn (+ initial-position delta))))
0
1)))
It's is pretty hard to follow what is happening there. Did anyone think of a better way of doing this?
1 Like
Hi, @felipetavares !
Happy advent.
Yours is pretty compact, well done.
I came up with this, as another data point:
(define (rotate/count-zeros pointer turn)
(define-values (rotations leftover) (quotient/remainder turn full-rotation))
(define result (+ pointer leftover))
(define zeroes
(case (sgn leftover)
[(-1)
(if (and (<= result 0) (< 0 pointer))
(+ (- rotations) 1)
(- rotations))]
[(+1)
(if (<= full-rotation result)
(+ rotations 1)
rotations)]
[else
(abs rotations)]))
(values
(modulo result full-rotation) zeroes))
2 Likes
Oh that's a much nicer idea IMO. Now wondering if that is a stepping stone for a nice closed form solution
This is the best I could do, inverting a bit of the logic of when I count when it ends up in a zero:
(define (zero-crossings initial-position delta)
(+
(abs (quotient delta field-size))
(let ([final-position (+ initial-position (remainder delta field-size))])
(if (or (< final-position 0)
(> final-position field-size)
(zero? initial-position))
1 0))))
EDIT: which is larger than my original one, but somehow I find this much more readable.
1 Like
shawnw
December 1, 2025, 12:57pm
5
I gave up on figuring out a formula for part 2 based on integer division after a few failed attempts and ended up just simulating turning the dial a click at a time via brute force. I'm not proud but it worked.
(define (part2 instructions)
(define (spin-the-dial dial distance)
(define delta (if (positive? distance) 1 -1))
(let loop ([dial dial]
[distance distance]
[zeros 0])
(cond
[(zero? distance) (values dial zeros)]
[else
(define new-pos (acase (+ dial delta)
[(-1) 99]
[(100) 0]
[else it]))
(loop new-pos (- distance delta) (if (zero? new-pos) (add1 zeros) zeros))])))
(for/fold ([zero-count 0]
[dial 50]
#:result zero-count)
([distance (in-list instructions)])
(define-values (new-pos zeros) (spin-the-dial dial distance))
(values (+ zero-count zeros) new-pos)))
Part 1 was a lot simpler:
(define (part1 instructions)
(for/fold ([zero-count 0]
[dial 50]
#:result zero-count)
([distance (in-list instructions)])
(define new-pos (modulo (+ dial distance) 100))
(values (if (zero? new-pos) (add1 zero-count) zero-count) new-pos)))
Not shown: Parsing the input into a list of numbers (R50 -> 50, L12 -> -12, etc.), and the definition of that anaphoric acase macro, which I tossed in because I wanted at least something clever.
2 Likes
Today I went full brute force, not sure if there was a much better solution I completely missed? Something with prime decomposition of string lengths?
(define (check-id id)
(let ([len (string-length id)])
(for/or ([step (in-inclusive-range 1 (/ len 2))])
(if (zero? (remainder len step))
(for/and ([idx (in-range step len step)])
(equal? (substring id 0 step) (substring id idx (+ idx step))))
#f))))
(define (check num-range)
(for/list ([id (in-inclusive-range (first num-range) (second num-range))])
(if (check-id (number->string id)) id 0)))
shawnw
December 2, 2025, 2:01pm
7
I used Common Lisp instead of Racket for today's problem, but the equivalents to some things I did in it:
string=srfi/13 string library lets you compare sections of strings, avoiding the need for substring and saving the garbage collector from a lot of extra work.
The maximum length of a string representation of the numbers in the puzzle input is something like 10 characters. For part 2, it's trivial to create a pre-defined set of possible lengths of subsequences of the strings and use them instead of always looping through a range and repeatedly figuring out which numbers work. For example, an 8 digit number can have subsequences of length 1, 2 or 4. I just had a vector of lists of those lengths and only checked against the appropriate one ((for/or ([len (in-list (vector-ref groupings (string-length num)))]) (repeats-length-n? num len))).
2 Likes
Haha, why'd I use numbers?
(define (comp limit)
(if (not limit) values (lambda (k) (= k limit))))
(define (cons=? x y)
(if (pair? y) (and (= x (car y)) (list x)) (cons x y)))
(define (repeated-number? x #:repeat [limit #false])
(define n (+ 1 (order-of-magnitude x)))
(define ? (comp limit))
(for/or ([k (in-list (divisors n))]
#:when (and (< 1 k) (? k)))
(define m (expt 10 (/ n k)))
(let residues ([x x] [p null])
(cond
[(not p) #false]
[else
(define-values (q r) (quotient/remainder x m))
(if (zero? q) (cons=? r p) (residues q (cons=? r p)))]))))
1 Like
@bakgatviooldoos I did start out trying to go the number route, but strings seemed too simple not to switch
EDIT: math/number-theory seems very cool! Didn't know about it!
1 Like
Today my weapon of choice was "inefficient list operations:"
(define (max-joltage n bank)
(if (and (> n 0) (>= (length bank) n))
(let* ([valid-len (- (length bank) (- n 1))]
[digit (apply max (take bank valid-len))])
(apply max
(for/list ([i (in-inclusive-range 1 valid-len)]
#:when (= (last (take bank i)) digit))
(+
(* (expt 10 (- n 1)) digit)
(max-joltage (- n 1) (drop bank i))))))
0))
Relied heavily on mutable sets for day four. For those "graphical" problems I often find the most sane (but perhaps not the most efficient) structure is just keeping a "bag of coordinates."
For example, reading the file is:
(define size
(for/last ([row (file->lines "input")]
[y (in-naturals)])
(for/last ([c row]
[x (in-naturals)])
(when (equal? c #\@)
(set-add! diag (cons x y)))
(cons x y))))
The operation of removing rolls wasn't pretty, though... I relied on a couple globals for counting the number of removed items and for signaling when no further items could be removed:
(define (rm p)
(set-remove! diag p)
(set! removed (+ removed 1))
(set! reduced #t))
(define (reduce)
(set! reduced #f)
(for ([pos diag])
(when (< (count (curry set-member? diag) (adj (car pos) (cdr pos))) 4)
(rm pos)))
(when reduced (reduce)))
I really wanted a better signaling mechanism there. I wonder if there is a more idiomatic way of doing it. I think if I used immutable sets I probably could integrate it in the recursion by comparing the old set and new set directly, but with mutable sets I am not sure.
Gosh, I got stuck in the morning, and then I got busy at work, so only got around to day 3 now.
It wrinkled my brain a bit for some reason, but in the end the solution was so simple. And it's quick, to boot.
(define (bank->joltage bank)
(for/fold ([sum 0])
([digit (in-list bank)])
(+ digit (* 10 sum))))
(define (candidates size bank)
(define sorted
(sort
(for/list ([digit (in-list bank)]
[index (in-naturals)]
#:do [(define left (- bank-size index))]
#:when (<= size left))
(cons digit index))
> #:key car))
(map
(lambda (candidate) (drop bank (cdr candidate)))
sorted))
(define ((max-joltage size) bank)
(define maximum
(let loop ([size size]
[bank bank])
(cond
[(zero? size) (list null)]
[(null? bank) (list #false)]
[else
(define maybe (candidates size bank))
(define best
(for*/first ([next (in-list maybe)]
[next′ (in-list (loop (- size 1) (cdr next)))]
#:when next′)
(cons (car next) next′)))
(if (not best) null (list best))])))
(bank->joltage (car maximum)))
(apply + (map (max-joltage 02) battery-banks))
(apply + (map (max-joltage 12) battery-banks))
I love how compact you manage to make these solutions, @felipetavares .
Now to day 4!
Edit: left some detritus there.
I ended up using a dictionary, which is a habit I picked up early on in the Advents.
(define (count-rolls rolls posn)
(define y (car posn))
(define x (cdr posn))
(for*/sum ([r (in-list '(-1 0 +1))]
[c (in-list '(-1 0 +1))]
#:when (not (= 0 r c)))
(case (hash-ref rolls (cons (+ y r) (+ x c)) #false)
[(#\@) 1] [else 0])))
(define (remove-accessible-rolls rolls)
(define accessible
(for/list ([(posn data) (in-immutable-hash rolls)]
#:when (and (eq? #\@ data) (< (count-rolls rolls posn) 4)))
posn))
(for/fold ([rolls rolls] #:result (values rolls (length accessible)))
([posn (in-list accessible)])
(hash-set rolls posn #\.)))
(define (remove-all-accessible-rolls paper-rolls [k 0])
(let loop ([total 0] [step k] [rolls paper-rolls])
(cond
[(zero? step) total]
[else
(define-values (removed delta) (remove-accessible-rolls rolls))
(if (zero? delta)
total
(loop (+ total delta) (- step 1) removed))])))
(remove-all-accessible-rolls paper-rolls +1)
(remove-all-accessible-rolls paper-rolls -1)
I feel like this is a nice "idiomatic" way of solving the problem, and immutable hash tables are fast enough.
Edit: oops.
1 Like
Using a stream (with a count enroute) and replacing the conditional check with a subtraction, makes it slightly faster:
(define (count-rolls rolls posn)
(define y (car posn))
(define x (cdr posn))
(sub1
(for*/sum ([r (in-list '(-1 0 +1))]
[c (in-list '(-1 0 +1))])
(case (hash-ref rolls (cons (+ y r) (+ x c)) #false)
[(#\@) 1] [else 0]))))
(define (remove-accessible-rolls rolls)
(define accessible
(for/stream ([(posn data) (in-immutable-hash rolls)]
#:when (and (eq? #\@ data) (< (count-rolls rolls posn) 4)))
posn))
(for/fold ([rolls rolls] [clear 0]
#:result (values rolls clear))
([posn (in-stream accessible)])
(values (hash-set rolls posn #\.) (+ clear 1))))
Lol, unless you're stupid like me, and add the empty cells back. Hmmm, I don't actually know if this was a good way of solving it, on second thought.
I didn't even know of for/stream!
I also really like the Cartesian for*/sum you got there... I just listed all possibilities, and it took a long time - partly because I was doing it on my phone.
For day 5 I projected all opening and closing values for the ranges into a single list, sorted that list, and then just used something similar to parenthesis balancing:
(define open 0)
(define curpos null)
(define fresh 0)
(for ([point (file->points "input")])
(match point
[`(,pos open)
(when (zero? open)
(set! curpos pos))
(set! open (add1 open))]
[`(,pos close)
(set! open (sub1 open))
(when (zero? open)
(set! fresh (+ 1 fresh (- pos curpos))))]))
One small hiccup here is that when both an open and close number are on the same position (same number), the open must always come before close.
I did that in the silliest possible way:
(sort number-line <
#:key (λ (num)
(+ (if (eq? (second num) 'open) 0 .5)
(first num))))))
Full part 2 solution
#lang racket
(define (file->parts file)
(map (lambda (group) (string-split group "\n"))
(string-split (file->string file) "\n\n")))
(define (parts->ranges parts)
(for/list ([r (first parts)])
(map string->number (string-split r "-"))))
(define (file->points file)
(let* ([parts (file->parts file)]
[ranges (parts->ranges parts)]
[number-line
(append*
(for/list ([range ranges])
(list
(list (first range) 'open)
(list (second range) 'close))))])
(sort number-line <
#:key (λ (num)
(+ (if (eq? (second num) 'open) 0 .5)
(first num))))))
(define open 0)
(define curpos null)
(define fresh 0)
(for ([point (file->points "input")])
(match point
[`(,pos open)
(when (zero? open)
(set! curpos pos))
(set! open (add1 open))]
[`(,pos close)
(set! open (sub1 open))
(when (zero? open)
(set! fresh (+ 1 fresh (- pos curpos))))]))
fresh
1 Like
shawnw
December 5, 2025, 7:41pm
16
The data/integer-set module
#lang racket/base
;;; Run as racket day05.rkt day05.txt
(require racket/file racket/function racket/list racket/string
(prefix-in is- data/integer-set))
(define (parse-input filename)
(define lines (file->lines filename))
(define-values (ranges ingredients) (splitf-at lines non-empty-string?))
(define intervals
(for/fold ((intervals (is-make-range)))
([range-str (in-list ranges)])
(define range (map string->number (string-split range-str "-")))
(is-union intervals (is-make-range (first range) (second range)))))
(values intervals (map string->number (rest ingredients))))
(define (part1 ranges ingredients)
(count (curryr is-member? ranges) ingredients))
(define (part2 ranges)
(is-count ranges))
(define (main filename)
(define-values (ranges ingredients) (parse-input filename))
(printf "Part 1: ~A\n" (part1 ranges ingredients))
(printf "Part 2: ~A\n" (part2 ranges)))
(main (vector-ref (current-command-line-arguments) 0))
2 Likes
For day 5, I went with a boring solution but I'll be sure to reach for @shawnw 's reference in future.
This is the second part, using pairs for the intervals themselves.
(define (fresh-ranges-total)
(define sorted (sort fresh-ranges < #:key car))
(let loop ([ranges sorted])
(match ranges
[(list) 0]
[(list* (cons a b) (cons c d) rest)
#:when (< b c)
(+ (+ (- b a) 1)
(loop (cons (cons c d) rest)))]
[(list* (cons a b) (cons c d) rest)
#:when (<= c b)
(loop
(cons (cons a (max b d))
rest))]
[(cons (cons a b) rest)
(+ (+ (- b a) 1)
(loop rest))])))
@shawnw I was wondering how fast your solution was... not only very neat, but also fast!
Used Plot: Graph Plotting for the first time to generate it, very nice library.
2 Likes
Today's problem was nice and easy; thank heavens for list transposes!
Spoilers
(define homework
(file->lines "input.txt"))
(define (split-row row)
(regexp-split #px"\\s+" (string-trim row)))
(define (transpose₁ homework)
(apply
map
(compose1 reverse list)
(map split-row homework)))
(define (transpose* homework)
(apply
map
(compose1 string-trim list->string list)
(map string->list homework)))
(define (op-word word)
(regexp-match #px"(\\d+)\\s*([+*])" word))
(define (transpose₂ homework)
(let loop ([data (transpose* homework)]
[accu null])
(match data
[(list) (map reverse accu)]
[(cons "" rest)
(loop rest accu)]
[(cons (app op-word op) rest)
#:when op
(loop rest (cons (cdr op) accu))]
[(cons num rest)
(loop rest
(cons (cons num (car accu))
(cdr accu)))])))
(define (grand-total problems)
(for/sum ([problem (in-list problems)])
(match problem
[(list "+" (app string->number nums) ...)
(apply + nums)]
[(list "*" (app string->number nums) ...)
(apply * nums)])))
; part 1
(grand-total (transpose₁ homework))
; part 2
(grand-total (transpose₂ homework))
I feel my part 1 was neat but my mind went to some weird place with part 2...
(define (solution file)
(interpret
(map string-trim
(string-split
(regexp-replace* #rx"(\\+|\\*)"
(string-join
(filter (compose not (curry equal? ""))
(flatten
(map
(compose string-trim list->string)
(reverse
(apply
map list
(map string->list (file->lines file)))))))
",")
",\\1")
","))))
Note the absolutely unhinged use of regular expressions and string operations, definitely what you would see in production web code!
Full part 2 solution
#lang racket
(define (interpret instructions)
(define accum 0)
(define args '())
(define result 0)
(for ((ins instructions))
(match ins
[n #:when (string->number n)
(set! args (cons (string->number n) args))]
["+" (set! result (+ result (apply + args))) (set! args '())]
["*" (set! result (+ result (apply * args))) (set! args '())]))
result)
(define (solution file)
(interpret
(map string-trim
(string-split
(regexp-replace* #rx"(\\+|\\*)"
(string-join
(filter (compose not (curry equal? ""))
(flatten
(map
(compose string-trim list->string)
(reverse
(apply
map list
(map string->list (file->lines file)))))))
",")
",\\1")
","))))
(solution "input")
1 Like
