Advent of Code 2025 Discussions

General
21

Part 1 for day 6 was just some splitting and zipping:

(define (parse-input/part1 filename)
  (call-with-input-file filename
    (lambda (port)
      (define columns (for/list ([line (in-lines port)])
                        (string-split (string-trim line))))
      (define eqns (apply map (compose reverse list) columns))
      (for/list ([eqn (in-list eqns)])
        (cons (first eqn) (map string->number (rest eqn)))))))

(define (part1 equations)
  (for/sum ([eqn (in-list equations)])
    (match eqn
      [(list* "+" nums)
       (foldl + 0 nums)]
      [(list* "*" nums)
       (foldl * 1 nums)])))

I too went strange places with part 2. Basically, I realized you could use the last line with the operations to determine the width of each column of numbers, and used that to break apart each line into substrings and turned each column into a list, so the sample input ended up looking like

'(("123" " 45" "  6") ("327" "64 " "98 ") (" 51" "387" "215") ("64 " "23 " "314"))

Then I turned each sublist into a list of numbers by walking each one once per column in it with a lot of string-ref's to extract digits. Using string->list would have looked more elegant but I bet my way ended up using less memory. (Plus I didn't think of it until skimming these posts.) Anyway once I had the numbers I just reused the same part1 from above on them.

Part 2 code 
(define (string-indexes s cs [start 0] [end (string-length s)])
  (for/list ([ch (in-string s start end)]
             [i (in-naturals start)]
             #:when (memv ch cs))
    i))

(define (string-split-on-indexes s indexes)
  (let loop ([prev-idx (first indexes)]
             [indexes (rest indexes)]
             [cols '()])
    (if (null? indexes)
        (reverse (cons (substring s prev-idx) cols))
        (loop (first indexes)
              (rest indexes)
              (cons (substring s prev-idx (sub1 (first indexes))) cols)))))

(define (parse-input/part2 filename)
  (match-define-values (numbers-lines (list ops-line))
                       (split-at-right (file->lines filename) 1))
  (define start-columns (string-indexes ops-line '(#\* #\+)))
  (define numbers-rows
    (map (curryr string-split-on-indexes start-columns) numbers-lines))
  (define numbers-cols (apply map list numbers-rows))
  (for/list ([col (in-list numbers-cols)]
             [op-i (in-list start-columns)])
    (let loop ([curr-col (sub1 (string-length (first col)))]
               [nums '()])
      (if (= curr-col -1)
          (cons (string (string-ref ops-line op-i)) nums)
          (loop (sub1 curr-col)
                (cons
                 (for/fold ([num 0])
                           ([digits (in-list col)]
                            #:do [(define c (string-ref digits curr-col))]
                            #:when (not (char=? c #\space)))
                   (+ (* num 10) (- (char->integer c) (char->integer #\0))))
                 nums))))))
1 Like
22

Day 7 part 1 is pretty cute!

#lang racket

(define active-beams (mutable-set))

(for/sum ([row (file->lines "input")])
  (for/sum ([c row] [x (in-naturals)])
    (match c
      [#\^ #:when (set-member? active-beams x)
       (set-remove! active-beams x)
       (set-add! active-beams (add1 x))
       (set-add! active-beams (sub1 x))
       1]
      [#\S (set-add! active-beams x) 0]
      [else 0])))

Part 2 I extended the same reasoning with a hash table counting the number of beams in each tile and a transfer function for each kind of input character.

1 Like
23

Nice, indeed, I ended up using a set for the first part and then refactoring to a hash table for the second part.

Spoilers 
#lang racket/base

(require
  racket/set)

(define tachyon-manifold
  (with-input-from-file "input.txt"
    (lambda ()
      (for/list ([line (in-lines)])
        (string->list line)))))

(define manifold-edge
  (sub1 (length (car tachyon-manifold))))

(define (beam-split beam)
  (define row (car beam))
  (define col (cdr beam))
  (let* ([fork* (if (<= 0 (- col 1) manifold-edge)
                    (list (cons row (- col 1)))
                    (list))]
         [fork* (if (<= 0 (+ col 1) manifold-edge)
                    (cons (cons row (+ col 1)) fork*)
                    fork*)])
    fork*))

(define (beam-update beams beam from)
  (hash-update
   beams beam (lambda (count) (+ count (hash-ref beams from))) 0))

(define (beams-update beams from fork*)
  (for/fold ([beams beams])
            ([beam (in-list fork*)])
    (beam-update beams beam from)))

(define (beams-total beams)
  (define last (sub1 (length tachyon-manifold)))
  (for/sum ([(posn count) (in-immutable-hash beams)]
            #:when (= last (car posn)))
    count))

(define (propagate-beams manifold)
  (for/fold ([beams (hash)]
             [split 0]
             #:result (values (beams-total beams) split))
            ([(cells row) (in-indexed (in-list manifold))])
    (for/fold ([beams beams]
               [split split]
               #:result (values beams split))
              ([(cell col) (in-indexed (in-list cells))])
      (define from (cons (- row 1) col))
      (define beam (cons row col))
      (case cell
        [(#\S)
         (values (hash-set beams beam 1) split)]
        [(#\.)
         (if (hash-has-key? beams from)
             (values (beam-update beams beam from) split)
             (values beams split))]
        [(#\^)
         (cond
           [(hash-has-key? beams from)
            (define -<* (beam-split beam))
            (define -<N (if (null? -<*) 0 1))
            (values (beams-update beams from -<*) (+ split -<N))]
           [else
            (values beams split)])]))))
1 Like
24

I really need to get on the immutable train!

25

For me today was a big lesson in keeping it simple. I did a lot of thinking about k-d trees and grids before staring at the ceiling for a few minutes, going "wait a second... this isn't that much" and just brute-forcing it (with some pretty ugly code).

Part 2 full solution

I'm so sorry about this code :see_no_evil_monkey:

#lang racket

(define (dist x y)
  (let ([delta (for/list ([nth `(,first ,second ,third)])
                 (- (nth y) (nth x)))])
    (apply + (map (curryr expt 2) delta))))

(define
  coords
  (map (λ (v) (map string->number v))
   (map (curryr string-split ",")
    (file->lines "test"))))

(define distances
  (sort #:key first
        (for*/list ([i (combinations coords 2)])
          (list (dist (first i) (second i)) (first i) (second i))) <))

(define circuits (for/list ([coord coords]) (set coord)))

(for ([distance distances])
  (define new-set (set))

  (set! circuits
        (filter identity
                (for/list ([circuit circuits])
                  (if (or (set-member? circuit (second distance)) (set-member? circuit (third distance)))
                      (begin
                        (set! new-set (set-union new-set circuit))
                        (when (= (length coords) (length (set->list new-set)))
                          (display (* (first (second distance)) (first (third distance))))
                          (exit))
                        #f)
                      circuit))))

  (set! circuits (cons new-set circuits)))
1 Like
26

If it works, who's to complain? Well done on seeing the forest for the k-d trees.

Haha, I think the misdirect was the point of today. I got pretty frustrated due to my poor reading comprehension and came up with two different but equally wrong solutions before I erased everything and started over.

Spoilers 
(define distance
  (match-lambda**
    [{(list x y z) (list a b c)}
     (+ (sqr (- x a))
        (sqr (- y b))
        (sqr (- z c)))]))

(define pairwise-distances
  (sort
   #:key car
   (let loop ([junctions junctions])
     (cond
       [(null? junctions) null]
       [else
        (define j₁ (car junctions))
        (define j* (cdr junctions))
        (append
         (for/list ([j₂ (in-list j*)])
           (list (distance j₁ j₂) j₁ j₂))
         (loop j*))]))
   <))

(define (connect-circuits [steps 1] [top-k 3])
  (define-values (end-pair connected)
    (for/fold ([end-pair #false]
               [circuits (map set junctions)]
               #:result
               (values end-pair (sort circuits > #:key set-count)))
              
              ([shortest (in-list pairwise-distances)]
               [step     (in-range steps)])
      (match-define (list j₁ j₂) (cdr shortest))
      (define c₁ (findf (lambda (c) (set-member? c j₁)) circuits))
      (define c₂ (findf (lambda (c) (set-member? c j₂)) circuits))
      (cond
        [(equal? c₁ c₂) (values end-pair circuits)]
        [else
         (define remainder (remove* `(,c₁ ,c₂) circuits))
         (values (cdr shortest) (cons (set-union c₁ c₂) remainder))])))
  
  (values
   end-pair
   (for/product ([circuit (in-list connected)]
                 [_       (in-range top-k)])
     (set-count circuit))))

; part 1
(let-values ([(_ product₃) (connect-circuits 1000 3)])
  product₃)
; part 2
(let-values ([(end-pair _) (connect-circuits +inf.0 1)])
  (apply * (map car end-pair)))
1 Like
27

I too wasted much time with fancy complicated graph algorithm approaches before figuring out a simpler way that was fast. And I just realized I could have used a sorted list of distances instead of the priority queue I did use to make it simpler (But it's a library I wrote so a bit of dog-fooding going on there)...

Just picked up a new game (Octopath Traveller 0) so I have a feeling I might be done with AoC this year with my free time going towards playing it instead.

1 Like
28

Not quite dead yet.

Part 1 for day 9, in Typed Racket 
#lang typed/racket/base

(require racket/fixnum racket/match racket/string)

(: string->fixnum : String -> Fixnum)
(define (string->fixnum s) (assert (string->number s) fixnum?))

(: fxadd1 : Fixnum -> Fixnum)
(define (fxadd1 n) (fx+ n 1))

(: parse-input : Path-String -> (Vectorof (List Fixnum Fixnum)))
(define (parse-input filename)
  (call-with-input-file filename
    (lambda ([port : Input-Port])
      (for/vector : (Vectorof (List Fixnum Fixnum)) ([line (in-lines port)])
        (match (string-split line ",")
          [(list c r) (list (string->fixnum c) (string->fixnum r))])))))

(: part1 : (Vectorof (List Fixnum Fixnum)) -> Fixnum)
(define (part1 squares)
  (define len (vector-length squares))
  (let loop ([i 0] [j 1] [max-area : Fixnum -1])
    (cond
      [(= i len) max-area]
      [(= j len) (loop (add1 i) (+ i 2) max-area)]
      [else
       (define c1 (vector-ref squares i))
       (define c2 (vector-ref squares j))
       (loop i (add1 j)
             (fxmax max-area
                    (fx* (fxadd1 (fxabs (fx- (car c2) (car c1))))
                         (fxadd1 (fxabs (fx- (cadr c2) (cadr c1)))))))])))

(define sample-input (parse-input "day09_sample.txt"))
(define input (parse-input "day09.txt"))

(printf "Part 1 (Sample): ~A\n" (part1 sample-input))
(printf "Part 1: ~A\n" (part1 input))

First version used for*/fold instead of a complicated named let, but I found out that in-vector doesn't play well with TR without an inst wrapper around it, and the optimization coach warns about that and not being able to optimize it.

2 Likes
29

Octopath Traveller 0

Looks so nice!

Not quite dead yet.

\o/ I get to learn more functions from you :laughing:

My day 9 part 2 was absolutely disastrous! I got it somewhat working after reading up on polygon intersection on Wikipedia, but it was still wrong for many hours and many tries.

Then, I realized I would need powerful debugging tools, since everything was passing the test/sample but failing with the real input.

The simplest way I thought of doing so was to manually (vim-ing) convert the input to an SVG using <path>, and overlay the solutions my program was outputting with a simple <rect>.

This led to a big aha! moment...

Big spoilers! Problem visualization!

In my solution I was only checking the corners of the solution were inside the polygon. But I needed to check the edges didn't intersect anything as well!

image
image813×818 4.07 KB

After some fixups, tada! :partying_face:

image
image806×806 3.79 KB

And it's very ironic to me I overlooked this... because I have written a lot about this exact kind of thing!

1 Like
30

Yeah, today was the first day where I felt the need to "see" the problem, but once I busted out plot it felt a bit like cheating, because I could get away with a less general but sufficient solution.

All in all, a very fun puzzle; I got to use a macro, and one of my favourite websites from back when I was in school, geometryalgorithms.com, for the winding-number procedure, which I've used in previous Advents to great effect.

Spoilers 
(require
  (for-syntax
   racket/base)
  racket/list
  racket/match)

(define-match-expander complex
  (lambda (stx)
    (syntax-case stx ()
      [(_ x y) #'(and (app real-part x) (app imag-part y))]))
  
  (lambda (stx)
    (syntax-case stx ()
      [(_ x y) #'(make-rectangular x y)]
      [_ #'make-rectangular])))

(define (string->coordinate s)
  (apply complex (map string->number (regexp-split #px"," s))))

(define red-tiles
  (with-input-from-file "input.txt"
    (lambda ()
      (for/list ([line (in-lines)])
        (string->coordinate line)))))

(define area
  (match-lambda**
    [{(complex p.x p.y)
      (complex q.x q.y)}
     (* (+ (abs (- p.x q.x)) 1)
        (+ (abs (- p.y q.y)) 1))]))

(define discriminant
  (match-lambda**
    [{(complex p.x p.y)
      (complex q.x q.y)
      (complex o.x o.y)}
     (- (* (- q.x p.x) (- o.y p.y))
        (* (- o.x p.x) (- q.y p.y)))]))

(define .x real-part)
(define .y imag-part)

(define hull₁ `(,@red-tiles ,(car red-tiles)))
(define hull₂ `(,@(cdr hull₁) ,(car hull₁)))

(define cache (hash))
(define (cache! o wn)
  (begin0 wn (set! cache (hash-set cache o wn))))

(define (winding-number o)
  (cond
    [(hash-ref cache o #false)]
    [else
     (match-define (complex o.x o.y) o)
     (for/fold ([wn 0] #:result (cache! o wn))
               ([p (in-list hull₁)]
                [q (in-list hull₂)])
       (define Δ (discriminant p q o))
       (match* (p q)
         [{(complex p.x p.y)
           (complex q.x q.y)}
          (cond
            [(<= p.y o.y)
             (cond
               [(and (> Δ 0) (< o.y q.y)) (+ wn 1)]
               [else wn])]
            [(and (< Δ 0) (<= q.y o.y)) (- wn 1)]
            [else wn])]))]))

(define (bisected? around?)
  (for/or ([p (in-list hull₁)]
           [q (in-list hull₂)])
    (around? (+ p (/ (- q p) 2)))))

(define in-polygon?
  (compose1 not zero? winding-number))

(struct rectangle (area frame around?)
  #:transparent)

(define ϵ 1/2)

(define (bounds . corners)
  (define x-max (.x (argmax .x corners)))
  (define x-min (.x (argmin .x corners)))
  (define y-max (.y (argmax .y corners)))
  (define y-min (.y (argmin .y corners)))
  
  (rectangle
   (* (+ (- x-max x-min) 1)
      (+ (- y-max y-min) 1))
   (list
    (complex (- x-max ϵ) (- y-max ϵ))
    (complex (+ x-min ϵ) (- y-max ϵ))
    (complex (+ x-min ϵ) (+ y-min ϵ))
    (complex (- x-max ϵ) (+ y-min ϵ)))
   (match-lambda
     [(complex x y) (and (< x-min x x-max) (< y-min y y-max))])))

; part 1
(for*/fold ([best -inf.0])
           ([p (in-list red-tiles)]
            [q (in-list red-tiles)]
            #:unless (= p q))
  (max best (area p q)))
; part 2
(for*/fold ([best -inf.0])
           ([p (in-list red-tiles)]
            [q (in-list red-tiles)]
            #:unless (= p q)
            #:do [(define r (bounds p q))]
            #:when (andmap in-polygon? (rectangle-frame r))
            #:unless (bisected? (rectangle-around? r)))
  (max best (rectangle-area r)))
31

Using in-combinations makes things a bit cleaner (and faster, I suspect), which would've been useful on day 8 as well, but I had forgotten about it.

Spoilers 
; day 9
; part 1
(for/fold ([best -inf.0])
          ([pair (in-combinations red-tiles 2)])
  (max best (apply area pair)))
; part 2
(for/fold ([best -inf.0])
          ([pair (in-combinations red-tiles 2)]
           #:do [(define r (apply bounds pair))]
           #:when (andmap in-polygon? (rectangle-frame r))
           #:unless (bisected? (rectangle-around? r)))
  (max best (rectangle-area r)))

; day 8
(define pairwise-distances
  (sort
   #:key car
   (for/list ([pair (in-combinations junctions 2)])
     (cons (apply distance pair) pair))
   <))

As an aside, I started using complex numbers because I thought they would be useful when calculating areas, but I couldn't quite get the calculations to work, so I ended up deconstructing them anyhow. They were useful for the interpolation, though, which was fortunate.

Edit: I realized the area comparison could be reordered to speed it up a bit.

Spoilers 
(time
 (for/fold ([best -inf.0])
           ([pair (in-combinations red-tiles 2)]
            #:do [(define r (apply bounds pair))]
            #:when (< best (rectangle-area r))
            #:when (andmap in-hull? (rectangle-corners r))
            #:unless (hull-bisects? (rectangle-contains? r)))
   (rectangle-area r)))

;=> cpu time: 1343 real time: 1383 gc time: 468

Although this doesn't show the optimization for interpolated points, which I also realized only really needed to be calculated once.

1 Like
32

Oof! Day 10 was a murder scene!

I solved part 1 with your run of the mill recursive search, but part 2 just murdered my algorithms. I absolutely couldn't get it to run fast enough.

I suppose I am missing some cool termination conditions, some form of symmetry in the problem space, or some kind of partitioning/dynamic programming that allows me to split the problem in smaller ones and solve/reuse those.

I ended up solving part 2 with CP-SAT, so no Racket (tried to use csp but it was just a tad too slow with the constraints I could come up with).

Day 11 was pretty good though, after I figured out it was a DAG. Maybe it was said explicitly in the prompt, but I kind of skimmed over it.

It is one of the cutest solutions yet for me (not sure if fft->dac being the right path is for every input):

#lang racket

(require memo)

(define table
  (make-immutable-hash
   (map
    (curryr string-split #rx":? ")
    (file->lines "input"))))

(define/memoize (paths-to src dst)
  (if (equal? src dst)
      1
      (for/sum ([out (hash-ref table src '())])
        (paths-to out dst))))

(*
 (paths-to "svr" "fft")
 (paths-to "fft" "dac")
 (paths-to "dac" "out"))
33

Talk about misdirection! :laughing:

My solution went something like this, with sets of coordinates as is tradition:

; ...

(define (area-fits problem)
  (let* ([size (car problem)]
         [problem-area (apply * size)]
         [presents-area (for/sum ([number (cdr problem)]
                                  [present-index (in-naturals)])
                          (* number (length (set->list (list-ref presents present-index)))))])
    (>= problem-area presents-area)))

(length (filter area-fits problems))

Just realized I should have written (count area-fits problems).