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.
Dec 1st
(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.
Dec 2nd
(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.
Dec 3rd
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.
Dec 4th
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.
Dec 5th
(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 ")"))))))))
Dec 6th
(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.
Dec 7
(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).
Dec 8th
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 website♥.).
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.
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.
Dec 9th, continued
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.
