Advent of Code, 2025
Here is where I’ll post my solutions to Advent of Code using zshbrev. Spoilers ahead, and no promises that I’ll make it through the entire 12 days.
2025-12-01 15:05
(define (turn)
(define-parameters zero 0)
(fold
(fn
(with-result
(when
(zero?
(save
(modulo
(+ (string->number
(strse x "L" "-" "R" "")) y) 100)))
(zero (add1 (zero))))))
50
(read-lines))
(zero))
Last time I attempted Advent of Code, I got tangled up modifying the step one solutions to handle step two and then I ended up wanting to revisit step one but they were gone. So this year I’m going to try to paste a second copy before modifying and I hope that works out better.
(define (dial acc r d)
(with (+ d r)
(when
(or
(zero? it)
(= 100 it)
(< it 0 d)
(< d 100 it))
(acc))
(modulo it 100)))
(define (dial acc (? (fn (< x -100)) r) d)
(acc)
(dial acc (+ r 100) d))
(define (dial acc (? (fn (< 100 x)) r) d)
(acc)
(dial acc (- r 100) d))
(define (dial acc (? string? x) y)
(dial acc (string->number (strse x "L" "-" "R" "")) y))
(define (turn)
(define-parameters zero 0)
(fold (c dial (fn (zero (add1 (zero))))) 50 (read-lines))
(zero))
This was one of the hardest bugs I’ve ever had to debug.
I’ve had to write log parsers, differs between different logs from different versions, multiple implementations to check against each other, Emacs highlight-regexp and count-matches and so on. It took me ten tries on the Advent of Code website. I get paranoid that I had mistyped my answer in there.
The line that now says (< it 0 d), originally I had it as (<= it 0 d) but it gave false positives on rotating from zero.
For a while I had it as (and (< it 0) (<= 0 d)) which… doesn’t fix that problem at all. Even after coming up with the fix (< it 0
d), that gives false negatives on rotating exactly one rotation left from zero. But there’s no L100 in the data set? No, but my code before I cleaned it up had:
(dial acc (+ r 100)
(dial acc -100 d))
where it now says:
(acc) (dial acc (+ r 100) d)
…leading to lots and lots of zero to zero turns which came with a false positive in some versions and false positives in others.
A complete PEBCAK on my part but the hunt for the bug became a real adventure of trying to sift through clues in logs that were thousands of lines long.
2025-12-02 11:53
(define (valid? x) #t)
(define (valid? (= ->list x))
(->* x (split-at (/ (require even? (length x)) 2)) equal? not))
(define (sum-not-valids-in-range
(=
(fn
(map string->number (string-split x "-")))
(current end)))
(descend ((steps (- (add1 end) current)) current)
(+ (if (valid? current) 0 current)
(desc (sub1 steps) (add1 current)))))
(define (sum-not-valids)
(->>
(-> (read-string)
(string-split ",\n"))
(map sum-not-valids-in-range)
(reduce + 0)))
After adapting that same idea to part two with a few minor tweaks, it’s too slow! Works fine with the example data but not the full input. I hate it when I have a working solution that I really like beacuse it does something clever but have to write a whole new one that’s faster. This is a “Project Euler” type problem where I need to come up with a math solution instead of just list procressing. But then I don’t really hate it because I did come up with a good solution.
Inverting the puzzle by making an is-in-any-range? predicate and then we can generate all invalid numbers up to the ceiling and see if they’re in any range.
(define (is-in-any-range? x) (or (<= 1 x 19) (<= 51 x 69) (<= 72 x 85) (<= 86 x 113) (<= 411 x 466) (<= 525 x 652) (<= 660 x 782) (<= 859 x 1056) (<= 1626 x 1972) (<= 2768 x 3285) (<= 4002 x 4783) (<= 4919 x 5802) (<= 7025 x 8936) (<= 9096 x 10574) (<= 13004 x 15184) (<= 32138 x 36484) (<= 48548 x 61680) (<= 69302 x 80371) (<= 82984 x 100358) (<= 126397 x 148071) (<= 193276 x 237687) (<= 266408 x 302255) (<= 333117 x 414840) (<= 431250 x 455032) (<= 528410 x 680303) (<= 726807 x 764287) (<= 779543 x 880789) (<= 907442 x 983179) (<= 2558912 x 2663749) (<= 5117615 x 5149981) (<= 7702278 x 7841488) (<= 9231222 x 9271517) (<= 13413537 x 13521859) (<= 32295166 x 32343823) (<= 49829276 x 50002273) (<= 67606500 x 67729214) (<= 99990245 x 100008960) (<= 146086945 x 146212652) (<= 4747426142 x 4747537765) (<= 5552410836 x 5552545325) (<= 5858546565 x 5858614010) (<= 7454079517 x 7454227234) (<= 8764571787 x 8764598967) (<= 9999972289 x 10000034826)))
Okay, great! I checked that there’s no overlapping ranges in this particular data set. That means we can make an idempotent summer so we don’t add the same number twice.
(define summer (memoize (call-key* proc: + initial: 0)))
Now for a generator. The spine is just incrementing the numbers and the ribs are repeating them.
(define roof (biggest 2558912 2663749 1 19 72 85 82984 100358 86 113
193276 237687 51 69 779543 880789 13004 15184 2768 3285 4002 4783
7702278 7841488 7025 8936 5858546565 5858614010 5117615 5149981 4919
5802 411 466 126397 148071 726807 764287 7454079517 7454227234 48548
61680 67606500 67729214 9096 10574 9999972289 10000034826 431250
455032 907442 983179 528410 680303 99990245 100008960 266408 302255
146086945 146212652 9231222 9271517 32295166 32343823 32138 36484
4747426142 4747537765 525 652 333117 414840 13413537 13521859 1626
1972 49829276 50002273 69302 80371 8764571787 8764598967 5552410836
5552545325 660 782 859 1056))
(define (add-all-repeats seed big-number) (void))
(define (add-all-repeats seed number)
(with (require (c > roof) (string->number (conc number seed)))
(when (is-in-any-range? it) (summer it))
(add-all-repeats
seed it)))
Let’s hard code it to five-digit numbers which is okay for this particular input.
(define (generate-the-answer)
(do ((num 1 (add1 num)))
((< 100000 num) (summer))
(add-all-repeats num num)))
Okay, that’s a relief! Today was a lot easier to debug. I originally had the summer see the numbers even before they were repeating. But that bug was easy enough to find and fix.
2025-12-03 09:24
Okay, here we have a similar dilemma of “extracting” vs building up possible joltages and filtering for them like (strse? "9.*9"). Maybe if I start with extracting, that will still be useful as a fallback for any stragglers after a filtering solution.
(define (extract bank)
(with (find-tail
(is?
(biggest (butlast bank))) bank)
(list (car it) (biggest (cdr it)))))
(define (sum-joltages) (fold (fn (+ ((as-list extract) x) y)) 0 (read-list)))
Okay, that worked fine. I’m always remarkably bad at predicting what step two is gonna be. I feel like I’m gonna try extracting for step two also.
(define ((extract amount) bank)
(with (find-tail
(is?
(biggest (drop-right bank amount))) bank)
(cons (car it) ((extract (sub1 amount)) (cdr it)))))
(define ((extract 0) bank) (list (biggest bank)))
(define (sum-joltages) (fold (fn (+ ((as-list (extract 11)) x) y)) 0 (read-list)))
That worked! Weird feeling how Monday took all day because I was chasing a bug and even Tuesday took more than an hour, maybe closer to three hours, but this one my idea worked right away and the solution for part 1 was also the right direction for part 2. I lucked out! And/or am actually good at programming especially when it’s straight-forward list-processing like this.
2025-12-04 10:27
This time around (it's my second time attempting Advent of Code; I tried it in 2023 but quit before the end) I’m paying more attention to the story and I’m really getting into the Matt Groening–like shenanigans.
As for the puzzle, this type of 2d, maps-and-neighbors stuff is something I don’t have as much of a standard library for. SRFI-1 doesn’t really cover it so I’m starting more from scratch here and I’m buckling in, accepting that it might take a li’l more time and what write here I’ll get use out of later too. I actually thought to work a li’l bit ahead and look up some array stuff in the latter SRFI’s but then I didn’t have time to do that in November.
(define (count-accessible)
(define nodes (call-list (map call-string (read-lines))))
(define (get-node x y) (void))
(define (get-node x y)
(handle-exceptions exn (void)
((require procedure?
(nodes (require (c < -1) y)))
(require (c < -1) x))))
(define (get-neighbors x y)
(parse (c apply get-node)
(list-ec (: dx -1 2)
(: dy -1 2)
(if (not (= 0 dy dx)))
(list (+ x dx) (+ y dy)))))
(let ((width (length (nodes)))
(height (string-length ((nodes 0)))))
(sum-ec (: x 0 width)
(: y 0 height)
(if (eq? #\@ (get-node x y)))
(if (> 4 (count (is? #\@) (get-neighbors x y))))
1)))
Okay I like it when it works first try because I hate to put in more than one guess but this was right. Good. Also didn’t have any bugs.
Now onto part 2. I really have to give Advent of Code a stern scolding when it comes to accessibility: the dark grey text on dark grey background is really really really hard to read so I use einkbro’s light mode but that mode didn’t show the highlighted @ signs in the part 2 example. I had to toggle off the mode but then I almost can’t see anything on the screen. Bad bad elves!
But okay, I figured out from what the text says what to do.
(define (count-accessible)
(define nodes (call-list (map call-string (read-lines))))
(define (get-node x y) (void))
(define (get-node x y)
(handle-exceptions exn (void)
((require procedure?
(nodes (require (c < -1) y)))
(require (c < -1) x))))
(define (get-neighbors x y)
(parse (c apply get-node)
(list-ec (: dx -1 2)
(: dy -1 2)
(if (not (= 0 dy dx)))
(list (+ x dx) (+ y dy)))))
(let* ((width (length (nodes)))
(height (string-length ((nodes 0))))
(get-accessible
(lambda ()
(sum-ec (: x 0 width) (: y 0 height)
(if (memq (get-node x y) '(#\x #\@)))
(if (> 4 (count (fn
(memq x '(#\x #\@)))
(get-neighbors x y))))
(begin
((nodes y) x #\x)
1)))))
(descend ((accessible (get-accessible)))
(do-ec (: x 0 width) (: y 0 height)
(if (eq? #\x (get-node x y)))
((nodes y) x #\.))
(+ accessible (desc (get-accessible))))))
Okay. That worked. No wrong entries today either which always feels great. I could spot my bugs on the example output. The bug today was that while I realized right away that I need to count X as neighbors, I forgot that I needed to count X as self too. So I was done in a li’l less than an hour (three quarters rather) which is fine. More than yesterday but that’s OK. I had to implement all this 2D neighbors stuff. I liked the idea of using parse since it just elides voids.
2025-12-05 08:57
(define ((in-ranges? ranges) ingredient)
(any (fn (<= (first x) ingredient (second x))) ranges))
(define (count-fresh)
(receive (ranges ingredients)
(break number?
(with (read-list)
(strse* it
(: (=> start integer) "-" (=> end integer))
(conc "(" start " " end ")"))))
(count (in-ranges? ranges) ingredients)))
Today was a real head-scratcher because it seemed to me part 1 is a subset of December 2nd and part 2 is even easier than part one. Then I realized that the difference is that unlike December 2nd, this time our input data have overlapping ranges (something I checked for on Dec 2nd but almost forgot to do here). I’m grateful that the test input also did, or I would’ve wasted a guess on the real thing. Joining the ranges is just a smop once you know that it’s there.
(define (join-ranges single) single)
(define (join-ranges (and ((had hadd) (nak nadk) . tail) (hd . tl)))
(if (<= nak hadd)
(join-ranges (cons (list had (biggest hadd nadk)) tail))
(cons hd (join-ranges tl))))
(define (count-fresh)
(fold
(fn
(+ y 1 (second x) (- (first x)))) 0
(join-ranges
(sort
(take-while
list?
(with (read-list)
(strse* it
(: (=> start integer) "-" (=> end integer))
(conc "(" start " " end ")"))))))))
2025-12-06 08:35
(define (pivot table) (cons (map car table) (pivot (map cdr table))))
(define (pivot (? (c every null?) table)) '())
(define (cephaluate)
(reduce + 0
(map (o eval (c map string->read) reverse)
(pivot
(map string-split (read-lines))))))
Oh, wow, here’s what I’ve been dreading: an easy part 1 followed by a seemingly completely different part 2!
(define ((space-pad gl) str)
(conc str (make-string (- gl (string-length str)) #\space)))
(define (cephaluate)
(let* ((lines (read-lines))
(gl (biggest (map string-length lines))))
(reduce + 0
((over (eval
(map string->read
(cons* ((as-list list last) (car x))
((as-list butlast) (car x))
(cdr x)))))
(parse (?-> string? (fn (if (strse? x "^ +$") (values close: open:) x)))
(append
(map list->string
(pivot
(map (o string->list (space-pad gl)) lines)))
(list close:)))))))
I live for this convoluted maps of maps of maps of maps stuff! Very fun problem.
Uh but if I were to try to explain how my program works... Hmm. From the inside out:
Reads all lines as lines.
Adds extra spaces to the end so all lines are the same length.
Pivots the lists so columns become rows and rows become columns.
Then with Acetone’s parse I split the problems into their own lists.
I split out the operator (that’s the list last, butlast stuff) and put it first then read and eval each problem.
Then finally I sum all those answers up.
Didn’t have any bugs today. I did put in two redundant reverses that still gave me the right answer; I found them and removed them after getting the star while making this write up.
2025-12-07 10:32
(define-parameters splits 0)
(define (tachyon-count (prev current next . beams))
((over
(when (and (eq? x #\S) (eq? y #\.)) (current i #\S))
(when (and (eq? x #\S) (eq? y #\^))
(splits (add1 (splits)))
(next (sub1 i) #\S)
(next (add1 i) #\S)))
(prev) (current))
(tachyon-count
(cons* current next beams)))
(define (tachyon-count (last exit))
(splits))
(define (tachyon-count)
(tachyon-count (map call-string (read-lines))))
Now this is what I’m talking about! This is the longest I’ve spent on a part 1 so far. Even Dec 1st, which was my longest day, part 1 wasn’t where I got stuck. Here I knew what to do, it was just tricky to keep track of everything. Now onto part two of this wonderful puzzle!
After reading part two... what a let down! It’s just the non-idempotent version. Although smopping that together on a tired-brain day like today is easier said than done.
I apologize to the makers of Advent of Code for calling their hard work a let down, it’s just that the non-idempotent “naively recursive” version is what I almost wrote by accident for part 1. I checked myself in time before making that version so actually implementing it did take some time.
(define ((list->indices pred) lis)
(filter-map (fn (and (pred x) y)) lis (iota (length lis))))
(define (tachyon-count prev (next . beams))
(if (memq prev next)
(+
(tachyon-count (sub1 prev) beams)
(tachyon-count (add1 prev) beams))
(tachyon-count prev beams)))
(define (tachyon-count last '()) 1)
(define (tachyon-count)
(with
(remove
empty?
(map (as-list (list->indices (complement (is? #\.)))) (read-lines)))
(tachyon-count (caar it) (cdr it))))
(memoize! tachyon-count)
Before I thought to clean up the input it was hard to keep track of everything (I had prev, current, next, blank lines, passing through etc). And I had something that worked on the example input but was too slow for the real input. So I started over and that’s the version you see above. It introduced a bug (I forgot to pass through beams at first) which required some creative logging to find with ever-increasing indentation prefixes etc etc until the new version finally worked on the example input. But it was still too slow for the real input. And memoization fixed that and here we are. All in all an extra hour or two.
The hardest problem yet after the “breathers” of 5th and 6th, but I remember last time (2023) I was completely stumped on some problems even after spending a day with a paper notebook just thinking and thinking and so far we haven’t seen that. I remember back then having to postpone some of the stars like “Okay I’ll get back to this one later” and doing it in the evening or the next day or something and this year I’ve just done both of them in the morning except for the first day that did take all day. (And what a privilege to be able to work all day on a recreational puzzle!) Maybe it says more about how incredibly burnt out I was after the apartment move back then than about the difficulties of the puzzles.
Also this one felt more like a “knowledge test” than the preious entries. I knew about the basics of recursion vs iteration, idempotence vs shadowing, and the life-changing magic of memoization. I know about those things from books like SICP and PAIP. It’s less about me figuring out something clever and more about me having book learning. That doesn’t feel super fair.
Maybe I should take this opportunity to share some of that book learning: My part one solution went through every row once. That’s why it’s fast. It’s an iterative solution. The part two solution needs to go through every row for every beam splitter above it. It branches over three trillion times. That is too slow for even my super duper computer to figure out. But memoization, which in this case means having a hash-table that stores the results it has seen before, means that it doesn’t have to re-calculate subtrees it has seen before. It becomes fast again.
memoize! the brev-separate version does work even through match-generics (but it needs to be called after all the definitions) and zshbrev (since the entire file is compiled).
2025-12-08 19:50
I usually hope for a hard one but today I overslept or rather I had a hard time falling asleep and it’s already like two hours past my normal wake-up time and I have laundry day so I hope it’s an easy one today.
(define (read-csv) (map (o (strse* "[,\"]" " " ) list) (read-lines)))
I haven’t gotten to read the problem yet but I’m opening the wrong windows, pasting the wrong files etc. This is gonna be a hard day no matter how easy the problem is just from my own tiredness.
(define (pyth a b) (sqrt (+ (* a a) (* b b))))
(define (distance (x1 y1 z1) (x2 y2 z2))
(pyth (abs (- z1 z2))
(pyth (abs (- x1 x2)) (abs (- y1 y2)))))
Note to self: It was way slower when or both of these was memoized because they’re usually not called that often on the same inputs so the lookup costs more than it saves. Also note to self: I could save a little by removing the outermost sqrt. Orders of squares are the same as the order of roots.
Aaand it’s a super hard problem. We’re in the back half now folks! The deep end!
Back after breakfast break. This is three problems (distance in 3D space, keeping track of groups of circuits, and recursive pairwise comparison) that each on their own would’ve been enough the past week. I for one did not know how to check distances in 3D space so I had to figure it out. (I did know how to check them in 2D space.)
(define circuits (call-table))
(define (connect a b)
(unless (memq a (circuits b))
(with (append! (circuits a) (circuits b))
(for-each (fn (circuits x it)) it))))
This one, take-up-to is a goody that I should get around to putting in brev-separate. I use it all the time for RSS stuff. I’m sure it’ll come in use for more than one day this challenge:
(define ((take-up-to lim) lis)
(take lis (min lim (length lis))))
(define (mutate-cons! val (and lis (hd . tl)))
(set-cdr! lis (cons hd tl))
(set-car! lis val))
(define (insert-sorted! val lis)
(cond ((<= (car val) (caar lis))
(mutate-cons! val lis))
((null? (cdr lis))
(set-cdr! lis (list val)))
(else
(insert-sorted! val (cdr lis)))))
(define spans (call-table))
This divides up the half a million distances into spans.
After getting my two stars I wanted to keep optimizing and I timed it out that five or six was the fastest quotient. I started out with a hundred but that’s way slower. Even seven is slower and so is four. With five, we have 25909 spans (hash-table entries) with an average list length of just under twenty each. That’s an indictment of my fancy mutating cdr-setting insert-sorted!. But a testament to the glory of hash-tables.♥︎
(define (stash! contender)
(with (quotient (floor (car contender)) 5)
(this (spans it)
(if that
(insert-sorted! contender that)
(spans it (list contender))))))
(define (connect-and-count limit)
(define-parameter quitter limit)
(define boxes (read-csv))
((over (circuits x (list x))) boxes)
(pair-for-each
(fn (with (car x)
((over
(stash! (list (distance it x) it x)))
(cdr x)))) boxes)
(let/cc break
(for-each
(fn (for-each (fn (when (zero? (quitter)) (break 'ok))
(quitter (sub1 (quitter)))
(connect (second x) (third x))) (spans x)))
(sort (hash-table-keys (spans)))))
(with (sort (map length (delete-duplicates (hash-table-values (circuits)))) >)
(apply * (take (sort it >) 3))))
Getting a solution that even works on the example of part one took several hours (the actually figuring out the three parts of the problem took a long time and then I also had a bad bug in my connect routine where it worked until I was connecting existing networks). That solution was too slow for the real input—and that was still on the first star! The first problem was that I was running sort on all the distances and then took the limit on that sorted list. Running sort post-hoc on half a million entries was something I thought it would’ve been able to handle but apparently not.
Then I made an insert-sorted that, functionally (pure shadowing) inserted the new distances as I went instead of sorting them post-hoc. That finally gave me an answer for part one’s full data but it took several minutes to find the answer. So after reading part two, I made the mutating insert-sorted! and also added the spans. Initially I had spans by hundreds which gave me the answer in about twelve seconds or so. Really strange to me that sorting was the bottleneck but that’s what it was.
Now for part two:
(define (connect a b)
(unless (memq a (circuits b))
(with (append! (circuits a) (circuits b))
(for-each (fn (circuits x it)) it)))
(length (circuits a)))
(define (connect-and-count)
(define boxes (read-csv))
(define boxl (length boxes))
((over (circuits x (list x))) boxes)
(pair-for-each
(fn (with (car x)
((over
(stash! (list (distance it x) it x)))
(cdr x)))) boxes)
(let/cc break
(for-each
(fn (for-each (fn (when (= (connect (second x) (third x)) boxl)
(break (* (caadr x) (caaddr x))))) (spans x)))
(sort (hash-table-keys (spans))))))
I had it down to “just” twelve seconds to sort all the half a million distances, but then the connecting them all into one big network was still too slow. I tried several other algoritms for connect until I landed on the one I used above and I updated part one to match also. Since this was largely an optimization puzzle, I kept working on part one to make it faster making sure I’d still get the right answer and then applying it to part two. So today I didn’t submit any wrong answers either. It just took all day, is all.
I had a bunch of versions of connect which added all the boxes to all the boxes one by one. One of those versions was bugged (before I even had part one done). I felt like galaxy brain when I came up with the append! solution since it was so different than anything I had and such a Gordian shortcut. If some of y’all had that approach figured out right away I salute you.♥︎ For me it took some time getting there.
Wow!! I loved this puzzle! I had it ticking along slowly until I figured out a new way to connect and now the connection part is instant. I’m really proud of my solution. I ended up with getting the distance sorting down to under two seconds and the connection part to be instant. That’s a good optimization down from an instance sorting that timed out, and then I got it down to twelve seconds, so that then the connection part was what timed out. And now the whole thing is done in two secs. I loved this puzzle. It took all day but it was a day well spent and I learned a lot just by experimenting, without looking things up (beyond just reading the docs for SRFI-1, SRFI-69 and the other libraries I was using. Especially my own. I don't consider it cheating to read my docs I've written and posted to this capsule♥.).
Maybe this is backwards and rotty but I’m way more proud of spending a whole day on the problem like today than when I solve it quickly. Although as per ushe with me there’s a zone of suck where spending a couple of hours is what I’m least proud of compared to a fast solution or sticking to it all day.
2025-12-10 00:09
(After midnight after Dec 9th)
I’m hoping for easy ones from here on out and at first glance it seems like today delivered on that since I can use a similar pairwise comparison as yesterday. Unlike yesterday where I couldn’t figure out any easier way to count up the distances than to actually pyth them out, here an idea immediately comes to mind where I can discard candidates based on one or both axes and weed things out considerably, but I’ll try the more brute force wasteful approach first, maybe it’ll be enough.
(define (carpet (ax ay) (bx by)) (abs (* (- ax -1 bx) (- ay -1 by))))
(define (all-squares)
(with (read-csv)
(biggest (list-ec (:list a it) (:list b it) (carpet a b)))))
Sloppy! For the first time in a while I entered a wrong input into the website; I didn’t notice that my code gave the wrong answer on the example input, I was just happy that it was fast enough on both the example input and the actual input. It was, so I’m not gonna have to do anything fancy at least for part one, but, uh, being right is more important than being fast.♥︎ The bug was that I had forgotten the -1 above, counting the tile distances exclusive rather than inclusive.
Okay so unlike yesterday where I thought part one was pretty difficult on its own, here there’ a huge jump in difficulty by part two, or rather, what I did for part two is not super relevant for part two. But that’s okay. That’s why I like to get to part two quickly so I can know what I’m really supposed to do. (And the fact that it's often hard to predict is part of the fun of Advent of Code.)
It’s just after midnight and I haven’t figured out the second part yet.
2025-12-10 11:41
(More struggling with yesterday’s problem.)
Okay it’s the next morning! Back to yesterday’s problem before even looking at the new problem. Most of the following was written yesterday. I write and delete and write and delete, that’s my workflow.
The red tiles are all inside the area 1837,1574 to 98308,98188 so initializing a vector of vectors to fit that dies with OOM so we’re gonna have to get fancy and procedural.
(define (horizontal? line) #f)
(define (horizontal? ((ax y) (bx y))) #t)
(define (data->lines data)
(partition!
horizontal?
(map (compose sort list) data (cons (last data) data))))
(define nodes (read-csv))
(define h-lines #f)
(define v-lines #f)
(define red? (call-table))
((over (red? x #t)) nodes)
(define ((connected-v-line? point)
(start end))
(or (eq? start point)
(eq? end point)))
(define (bendy? (start end))
(with
(map second
(list
start
(find (complement (is? start))
(find (connected-v-line? start) v-lines))
(find (complement (is? end))
(find (connected-v-line? end) v-lines))))
(or (= (second start) (biggest it))
(= (second start) (smallest it)))))
(receive (hl vl)
(data->lines nodes)
(set! h-lines (map sort hl))
(set! v-lines (map sort vl))
(set! steppy-lines (remove bendy? h-lines)))
(define ((cross? (= sort ((mxl my) (mxh my))))
((gx gyl) (gx gyh)))
(and (< gyl my gyh)
(< mxl gx mxh)))
(define ((cross? (= sort ((mx myl) (mx myh))))
((gxl gy) (gxh gy)))
(and (< myl gy myh)
(< gxl mx gxh)))
(define ((cross? ((mx my) (mx my))) any) #f)
(define ((overlap? line) anything) #f)
(define ((overlap? ((mx myl) (mx myh)))
((gx gyl) (gx gyh)))
(and
(eq? mx gx)
(< myl gyl gyh myh)))
(define ((overlap? ((mxl my) (mxh my))) ((gxl gy) (gxh gy)))
(and
(eq? my gy)
(< mxl gxl gxh mxh)))
(define (inside? point)
(or (red? point)
(with (list (list 0 (second point)) point)
(odd?
(+ (count (cross? it) v-lines)
(count (overlap? it) steppy-lines))))))
(define-parameters best 2 heck '())
(define ((small ungreen?) ax ay bx by)
(ungreen?
(min (add1 ax) bx)
(min (add1 ay) by)
(max (sub1 bx) ax)
(max (sub1 by) ay)))
(define ((normalize ungreen?) ax ay bx by)
(ungreen? (min ax bx) (min ay by)
(max ax bx) (max ay by)))
(define (ungreen? ax ay bx by)
(or
(any (cross? `((,ax ,ay) (,ax ,by))) h-lines)
(any (cross? `((,bx ,ay) (,bx ,by))) h-lines)
(any (cross? `((,ax ,ay) (,bx ,ay))) v-lines)
(any (cross? `((,ax ,by) (,bx ,by))) v-lines)
(not
(every inside? `((,ax ,ay) (,bx ,ay) (,ax ,by) (,bx ,by))))))
(define (square-size ax ay bx by)
(* (add1 (- bx ax)) (add1 (- by ay))))
(define (carpet (ax ay) (bx by))
(with ((normalize square-size) ax ay bx by)
(unless
(or
(< it (best))
((normalize ungreen?) ax ay bx by)
((normalize (small ungreen?)) ax ay bx by))
(best it)
(heck `((,ax ,ay) (,bx ,by))))))
(define (path-format ((ax ay) (bx by)))
(conc "M " (/ ax 1000.0) " " (/ ay 1000.0)
"H " (/ bx 1000.0) " V " (/ by 1000.0)
"H " (/ ax 1000.0) "Z"))
(define (all-squares)
(do-ec (:list a nodes) (:list b nodes) (carpet a b))
(print "The answer " (best))
(print "which looks like this " (path-format (heck))))
Oh no I give up on this for now. So heartbroken.
I painted the red and green tiles both green in this image and superimposed my program’s best solution as a black rectangle on top.
But it’s not accepted as the right answer. I can’t see a better answer with my own eyes either. So I’m leaving this as a one star and I’m just that much closer to giving up on the entire Advent of Code. I obsess over it, I spend all day on it in this horrible hyperfocused state. Other activities like playing games with friends or eating food become stress isntead of joy. And to boot I’m still not smart enough to actually solve the problems!
I’ll go and take a look at Dec 10th’s problem.