Advent of Code 2024

>Collect stars by solving puzzles. Two puzzles will be made available on each day in the Advent calendar; the second puzzle is unlocked when you complete the first. Each puzzle grants one star. Good luck! https://adventofcode.com/ last year: >>37777

>To play, please identify yourself via one of these services: >[GitHub] [Google] [Twitter] [Reddit] Yeah, I don't think I will...

>>40518 So sad. So many cool things on the internet. I'll never use them for same reason.

>>40518 Your loss, it's fun. Just make an empty GH account and never use it.

>>40520 An empty github account, made with my empty e-mail address that I made with an empty phone number? Sure it is possible, but that's way more hastle than necessary (that would be a single cookie to link an answer to its input).

>>40518 Are you aware of the the notion of throwaway accounts? The elite don't want you to know this but you can create an email address and use it just one. I have 512 forgotten email adresses.

>>40522 Stuff like oneminutemail where you're assigned a virtual mailbox address to receive a single email and forget about it, is mostly unusable. Even if site you register at allows it, one day it will say there's something sus about your activity and you should go get the numbers in confirmation email and you're fuarrrked. If you mean literally registering full featured email accounts, it's not as easy as it was 20 years ago, now you have to do phone confirmation almost everywhere. Last time I wanted an extra email account it took me hours and I ended up using an email service from small african country looking like it's from 90s. That was the only one that allowed me to get an email with no strings attached.

>>40521 you can easily make a throwaway reddit account when i did it i never had to verify my email >>40521 github needs a phone number now, unfortunately

>>40524 Phone number? Absolutely not. I've made a half dozen accounts over the last few years and none asked for that, in fact just made another one now over Tor, and it only asked me to solve a captcha.

>>40518 Yeah, it's such a shame. The hassle of making a burner account and the hassle of getting each day uploaded somewhere else just so lainons can have fun without having to deal with this soykaf. It's why I stopped doing these. Oh well.

>>40524 You're fake news. You can use OTP

Well, here we go. Decided to do it in all the languages I decently know for the first day only. Common Lisp. Exceptionally, I made two versions: an "idiomatic" one (using only uiop and iterate): (load "~/.local/lib/quicklisp/setup.lisp") (ql:quickload "iterate" :silent t) (use-package :iterate) (let (keys vals) (iter (for (k v) on (uiop:read-file-forms (car uiop:*command-line-arguments*)) by #'cddr) (push k keys) (push v vals)) (setf keys (sort keys #'<) vals (sort vals #'<)) (format t "Part 1: ~A~%" (iter (for k in keys) (for v in vals) (sum (abs (- k v))))) (format t "Part 2: ~A~%" (iter (with vtally = (iter (with ret = (make-hash-table)) (for v in vals) (incf (gethash v ret 0)) (finally (return ret)))) (for k in keys) (sum (* k (gethash k vtally 0)))))) And another with a rc file including more stuff (incl. my utils system) and reducing boilerplate for the next days: (load "../rc") (in-package #:q3cpma-user) (destructuring-bind (keys vals) (plist:separate (read:all-from-file *input-path*)) (misc:sortf keys #'<) (misc:sortf vals #'<) (format t "Part 1: ~A~%" (iter (for k in keys) (for v in vals) (sum (abs (- k v))))) (format t "Part 2: ~A~%" (iter (with vtally = (list:tally vals)) (for k in keys) (sum (* k (gethash k vtally 0)))))) rc file: (load "~/.local/lib/quicklisp/setup.lisp") (asdf:load-system "q3cpma-utils") ;; https://git.sr.ht/~q3cpma/cl-utils (in-package #:q3cpma-user) (ql:quickload '("array-operations") :silent t) (defparameter *input-path* (car uiop:*command-line-arguments*)) PS: don't forget to convert your tabs to spaces before posting in here!

>>40530 C99 (with a little trick to run via sh): #if 0 // POSIX script mode: run with `sh file.c ARGS...` set -eu bin=$(echo "mkstemp(/tmp/tmp.XXXXXX)" | m4) trap 'exit 1' HUP INT QUIT ABRT TERM trap 'rm "$bin"' EXIT if command -v gcc >/dev/null; then cc='gcc -Wall -Wextra -std=c99 -pedantic' elif command -v clang >/dev/null; then cc='clang -Wall -Wextra -std=c99 -pedantic' else cc=c99; fi $cc -O "$0" -o "$bin" && exec "$bin" "$@" #endif #include <assert.h> #include <stdbool.h> #include <stdio.h> #include <stdlib.h> static int int_cmp(const void *a, const void *b) {return *(int *)a - *(int *)b;} #define VEC(T) struct {size_t l, c; T *d;} #define VEC_PUSH(V, EL) \ { \ if ((V).l == (V).c) \ (V).d = realloc((V).d, sizeof(*(V).d) * ((V).c = (V).c ? (V).c * 2 : 8)); \ (V).d[(V).l++] = EL; \ } #define VEC_SORT(V, CMPFUN) qsort((V).d, (V).l, sizeof(*(V).d), CMPFUN) int main(int argc, char **argv) { assert(argc == 2); FILE *f = fopen(argv[1], "r"); assert(f); VEC(int) keys = {0}; VEC(int) vals = {0}; for (int k, v; fscanf(f, "%d %d", &k, &v) != EOF; ) { VEC_PUSH(keys, k); VEC_PUSH(vals, v); } VEC_SORT(keys, int_cmp); VEC_SORT(vals, int_cmp); int dsum = 0; for (size_t i = 0; i < keys.l; ++i) dsum += abs(keys.d[i] - vals.d[i]); printf("Part 1: %d\n", dsum); struct kvpair {int k; size_t v;}; VEC(struct kvpair) vtally = {0}; for (size_t vi = 0; vi < vals.l; ++vi) { const int val = vals.d[vi]; bool found = false; for (size_t ti = 0; ti < vtally.l; ++ti) { if (vtally.d[ti].k == val) { ++vtally.d[ti].v; found = true; break; } } if (!found) VEC_PUSH(vtally, ((struct kvpair){val, 1})); } int scoresum = 0; for (size_t ki = 0; ki < keys.l; ++ki) { const int key = keys.d[ki]; for (size_t ti = 0; ti < vtally.l; ++ti) { if (vtally.d[ti].k == key) { scoresum += key * vtally.d[ti].v; break; } } } printf("Part 2: %d\n", scoresum); }

>>40531 (Initially tried to make a generic MAP macro, but it was too painful/large when I know I won't use it more than once, so linear search it was.) POSIX-2024 sh: #!/bin/sh set -eu # Poor man's mktemp -d i=0; until mkdir /tmp/dir$i; do i=$((i + 1)); done; d=/tmp/dir$i trap 'exit 1' HUP INT QUIT ABRT TERM trap 'rm -r "$d"' EXIT in=$(realpath -- "$1") cd "$d" awk '{print $1}' "$in" | sort -g >k awk '{print $2}' "$in" | sort -g >v printf '%s' "Part 1: " paste -d - k v | bc | tr -d - | paste -sd+ - | bc printf '%s' "Part 2: " uniq -c v | join -22 k - | tr ' ' '*' | paste -sd+ - | bc

>>40532 Tcl 8.6: #!/usr/bin/env tclsh namespace path {::tcl::mathop ::tcl::mathfunc} try { set chan [open [lindex $argv 0]] set data [read $chan] } finally { close $chan } set keys [lsort -int [lmap {1 2} $data {set 1}]] set vals [lsort -int [lmap {1 2} $data {set 2}]] set p1 [+ {*}[lmap k $keys v $vals {abs [- $k $v]}]] puts "Part 1: $p1" foreach v $vals {dict incr vtally $v} set p2 [+ {*}[lmap k $keys { # Tcl 9: use [dict getwidthdefault $vtally $k 0] if {![dict exists $vtally $k]} continue * $k [dict get $vtally $k] }]] puts "Part 2: $p2"

>>40533 Python (could have used collections.Counter, but fuarrrk that unintuitive crap). #!/usr/bin/env python import sys with open(sys.argv[1]) as f: data = [int(x) for x in f.read().rstrip().split()] keys = sorted(data[0::2]) vals = sorted(data[1::2]) p1 = sum(abs(k - v) for (k, v) in zip(keys, vals)) print(f"Part 1: {p1}") vtally = {} for v in vals: vtally[v] = vtally.get(v, 0) + 1 p2 = sum(k * vtally.get(k, 0) for k in keys) print(f"Part 2: {p2}") And that's it! No one else? Last year here had a lot more participants.

>>40534 That's super clean. I used go, and there's a lot more "boilerplate" in go than there is in python.

#include <stdio.h> #include <stdlib.h> #include <string.h> #define LINES 1000 #define LINE_SIZE 14 #define MAX_VALUE 100000 void count_sort(int* arr, int exp) { int out[LINES]; int count[10] = {0}; for (int i = 0; i < LINES; i++) { count[(arr[i] / exp) % 10]++; } for (int i = 1; i < 10; i++) { count[i] += count[i - 1]; } for (int i = LINES - 1; i >= 0; i--) { out[count[(arr[i] / exp) % 10] - 1] = arr[i]; count[(arr[i] / exp) % 10]--; } for (int i = 0; i < LINES; i++) { arr[i] = out[i]; } } void radix_sort(int* arr) { int max = arr[0]; for (int i = 1; i < LINES; i++) { if (arr[i] > max) max = arr[i]; } for (int exp = 1; max / exp > 0; exp *= 10) { count_sort(arr, exp); } } int parse_input(int* left, int* right, int* freqs) { FILE* fp; char* buf; char* ptr; fp = fopen("input.txt", "r"); if (fp == NULL) { perror("fopen"); return 1; } buf = malloc(LINES * LINE_SIZE); if (buf == NULL) { perror("malloc"); fclose(fp); return 1; } memset(freqs, 0, MAX_VALUE * sizeof(int)); fread(buf, LINE_SIZE, LINES, fp); fclose(fp); ptr = buf; for (int i = 0; i < LINES; i++) { left[i] = (ptr[0] - '0') * 10000 + (ptr[1] - '0') * 1000 + (ptr[2] - '0') * 100 + (ptr[3] - '0') * 10 + (ptr[4] - '0'); right[i] = (ptr[8] - '0') * 10000 + (ptr[9] - '0') * 1000 + (ptr[10] - '0') * 100 + (ptr[11] - '0') * 10 + (ptr[12] - '0'); freqs[right[i]]++; ptr += LINE_SIZE; } free(buf); return 0; } int main(void) { int left[LINES], right[LINES], freqs[MAX_VALUE], td, ss; if (parse_input(left, right, freqs) != 0) { return EXIT_FAILURE; } radix_sort(left); radix_sort(right); td = 0; ss = 0; for (int i = 0; i < LINES; i++) { td += abs(left[i] - right[i]); ss += left[i] * freqs[left[i]]; } printf("Travel Distance: %d\nSimilarity Score: %d\n", td, ss); return EXIT_SUCCESS; }

I feel REALLY dirty doing it that stupidly and consing that much, but whatever... (load (make-pathname :defaults *load-truename* :name "../rc")) (in-package #:q3cpma-user) (defun safe-report-p (report) (and (or (apply #'< report) (apply #'> report)) (every (lambda (Δ) (<= 1 (abs Δ) 3)) (mapcar #'- report (cdr report))))) (defun possible-holes (list) (flet ((punch-hole (list n) (if (zerop n) (cdr list) (let* ((fresh (copy-list list)) (cons (nthcdr (- n 1) fresh))) (setf (cdr cons) (cddr cons)) fresh)))) (iter (for i below (list-length list)) (collect (punch-hole list i))))) (let ((reports (read:all-from-file *input-path* :reader (reader:until-char #\Newline)))) (format t "Part 1: ~A~%" (count-if #'safe-report-p reports)) (format t "Part 2: ~A~%" (count-if (lambda (r) (or (safe-report-p r) (some #'safe-report-p (possible-holes r)))) reports)))

>>40543 "Less worse", but still not to my taste. Anyone did it the clever way? (load (make-pathname :defaults *load-truename* :name "../rc")) (in-package #:q3cpma-user) (named-readtables:in-readtable :q3cpma/readtable) (defun safe-report-p (report) (and (or (apply #'< report) (apply #'> report)) (every #λ(<= (abs _) 3) (mapcar #'- report (cdr report))))) (defun possible-holes (list) (mapcar #λ(remove-if (constantly t) list :start _ :count 1) (alexandria:iota (length list)))) (let ((reports (read:all-from-file *input-path* :reader (reader:until-char #\Newline)))) (format t "Part 1: ~A~%" (count-if #'safe-report-p reports)) (format t "Part 2: ~A~%" (count-if #λ(or (safe-report-p _) (some #'safe-report-p (possible-holes _))) reports)))

Regex today! Used Go again, the regex was really easy with the standard library. r := regexp.MustCompile(`don't\(\)|do\(\)|mul\([0-9]*,[0-9]*\)`) matches := r.FindAllString(val, -1)

Day 3. Rolled out my own parser combinators, which I do not include for the sake of brevity. data Instruction = Mul Integer Integer | Do | Dont deriving Show eval :: [Instruction] -> [Integer] eval is = eval' is Do where eval' [] _ = [] eval' (Do : is) _ = eval' is Do eval' (Dont : is) _ = eval' is Dont eval' (m : is) Do = (evalMul m) : (eval' is Do) eval' (_ : is) Dont = eval' is Dont evalMul (Mul a b) = a * b isMul :: Instruction -> Bool isMul (Mul _ _ ) = True isMul _ = False digitsParser :: Parser [Integer] digitsParser = listParser digitParser integerFromDigits :: [Integer] -> Maybe Integer integerFromDigits (a : []) = Just a integerFromDigits (a : b : []) = Just (a * 10 + b) integerFromDigits (a : b : c : []) = Just (a * 100 + b * 10 + c) integerFromDigits _ = Nothing instructionsParser :: Parser [Instruction] instructionsParser = allParser instructionParser instructionParser :: Parser Instruction instructionParser = oneOfParser [mulParser, doParser, dontParser] -- mul(x,y) mulParser :: Parser Instruction mulParser = do stringParser "mul" charParser '(' x <- mapMaybe integerFromDigits digitsParser charParser ',' y <- mapMaybe integerFromDigits digitsParser charParser ')' return (Mul x y) -- do() doParser :: Parser Instruction doParser = (const Do) <$> (stringParser "do()") -- don't() dontParser :: Parser Instruction dontParser = (const Dont) <$> (stringParser "don't()") part1 = part1' <$> readInput 3 part1' :: String -> Integer part1' s = sum $ evalMuls $ parseOr [] instructionsParser s where evalMuls is = eval $ filter isMul is part2 = part2' <$> readInput 3 part2' :: String -> Integer part2' s = sum $ eval $ parseOr [] instructionsParser s

>>40544 Piece of cake today. Hardest part was noticing that the second sample isn't the same as the first... (in-package #:q3cpma-user) (let ((mem (uiop:read-file-string (car uiop:*command-line-arguments*))) (mul-re "mul\\((\\d{1,3}),(\\d{1,3})\\)")) (format t "Part 1: ~A~%" (let ((acc 0)) (cl-ppcre:do-register-groups (x y) (mul-re mem acc) (incf acc (* (parse-integer x) (parse-integer y)))))) (format t "Part 2: ~A~%" (iter (with mul-on = t) (for ins in (cl-ppcre:all-matches-as-strings (uiop:strcat mul-re "|do(n't)?\\(\\)") mem)) (match ins ((ppcre mul-re x y) (when mul-on (sum (* (parse-integer x) (parse-integer y))))) ("do()" (setf mul-on t)) ("don't()" (setf mul-on nil)))))) >>40548 Technically wrong, "mul(X,Y)" is specified as taking 1-3 digit integers, you're lucky the author didn't fuarrrk with you. >>40550 Was this actually needed? Does Haskell (it's Haskell, right?) not have regexps and string->integer?

>>40552 Sure, I could have used regular expressions in Haskell. But I found the design of parser combinators much more enjoyable.

One of the ads (the one for CodeCrafters.io) on the right side asked to solve the following: PWFI YFRP, ZIK XVNVC% KTW GOXA MMQEMOTH Anyone know what this translates to?

day 4 part 1. this is the most braindead solution I could come up with but it works. regex didn't work for some reason. part 2 made me mad so I havent done it yet. func p1(vals []string) { xmas := 0 mx := len(vals) - 3 for i, line := range vals { for j, _ := range line { if j < mx { if (vals[i][j] == 'X' && vals[i][j+1] == 'M' && vals[i][j+2] == 'A' && vals[i][j+3] == 'S') || (vals[i][j] == 'S' && vals[i][j+1] == 'A' && vals[i][j+2] == 'M' && vals[i][j+3] == 'X') { xmas++ } } if i < mx { if (vals[i][j] == 'X' && vals[i+1][j] == 'M' && vals[i+2][j] == 'A' && vals[i+3][j] == 'S') || (vals[i][j] == 'S' && vals[i+1][j] == 'A' && vals[i+2][j] == 'M' && vals[i+3][j] == 'X') { xmas++ } } if i < mx && j < mx { if (vals[i][j] == 'X' && vals[i+1][j+1] == 'M' && vals[i+2][j+2] == 'A' && vals[i+3][j+3] == 'S') || (vals[i][j] == 'S' && vals[i+1][j+1] == 'A' && vals[i+2][j+2] == 'M' && vals[i+3][j+3] == 'X') { xmas++ } } if i >= 3 && j < mx { if (vals[i][j] == 'X' && vals[i-1][j+1] == 'M' && vals[i-2][j+2] == 'A' && vals[i-3][j+3] == 'S') || (vals[i][j] == 'S' && vals[i-1][j+1] == 'A' && vals[i-2][j+2] == 'M' && vals[i-3][j+3] == 'X') { xmas++ } } } } fmt.Printf("match: %d\n", xmas) }

>>40552 Not hard, but needed a bit of elbow grease to factorize the two parts. Remembered that global variables are cool for this. (in-package #:q3cpma-user) (defparameter *map* (apply #'array-operations:stack-rows* 'standard-char (uiop:read-file-lines *input-path*))) (defconstant +all-dirs+ '#.(delete '(0 0) (map-product #'list '(-1 0 1) '(-1 0 1)) :test 'equal)) (defconstant +diag-only+ '#.(delete-if (curry #'member 0) (map-product #'list '(-1 0 1) '(-1 0 1)))) (defun word-look (word pos dirs) (iter (with (y x) = pos) (with dist = (- (length word) 1)) (for (Δy Δx) in dirs) (when (and (array-in-bounds-p *map* (+ y (* Δy dist)) (+ x (* Δx dist))) (iter (for c in-string word with-index i) (always (char= c (aref *map* (+ y (* Δy i)) (+ x (* Δx i))))))) (collect (list (+ y Δy) (+ x Δx)))))) ;; Return the second letter position (defun word-search (word dirs) (mapcan (lambda (pos) (word-look word pos dirs)) (array:position-all (char word 0) *map*))) (format t "Part 1: ~A~%" (length (word-search "XMAS" +all-dirs+))) (format t "Part 2: ~A~%" (count 2 (hash-table-values (list:tally (word-search "MAS" +diag-only+) :test 'equal)))) >>40568 Lol, Go devs in a nutshell.

Gofriend here. I ended up solving yesterday's part 2 as well, turned out to be pretty simple. could probably be more elegant but that's not really my priority, still trying to get familiar with go. func p2(vals []string) int { mas := 0 for i := 1; i < len(vals)-1; i++ { for j := 1; j < len(vals[i])-1; j++ { // only check around if we're on A if vals[i][j] == 'A' { vword := fmt.Sprintf("%c%c%c", vals[i-1][j], vals[i][j], vals[i+1][j]) hword := fmt.Sprintf("%c%c%c", vals[i][j-1], vals[i][j], vals[i][j+1]) if (vword == "MAS" || vword == "SAM") && (hword == "MAS" || hword == "SAM") { fmt.Printf("vertical cross %s %s\n", vword, hword) //mas++ } d1word := fmt.Sprintf("%c%c%c", vals[i-1][j-1], vals[i][j], vals[i+1][j+1]) d2word := fmt.Sprintf("%c%c%c", vals[i+1][j-1], vals[i][j], vals[i-1][j+1]) if (d1word == "MAS" || d1word == "SAM") && (d2word == "MAS" || d2word == "SAM") { fmt.Printf("diagonal cross %s %s\n", d1word, d2word) mas++ } } } } return mas } today's p1 was also pretty easy but I've also not done part 2 yet, still thinking about it.

>>40590 Ha right ended up leaving my vertical cross checker in; I didn't realize I was only supposed to check for the X shape and not the + shape as well.

Day 5. I immediately thought "topological sort", but maybe there was a simpler, brute force way of doing this? Did it in POSIX sh first: #!/bin/sh set -eu mkdir /tmp/aoc2024 trap 'exit 1' HUP INT QUIT ABRT TERM trap 'rm -r /tmp/aoc2024' EXIT in=$(realpath -- "$1") cd /tmp/aoc2024 sed '/^$/,$d; s/|/ /' "$in" >rules sed '1,/^$/d' "$in" | while IFS= read -r upd do pat=$(echo "$upd" | tr , '|') upd=$(echo "$upd" | tr , '\n') grep -E "^($pat) ($pat)\$" rules | tsort >ord echo "$upd" | grep -Fxf ord | cmp -s - ord && out=p1 || out=p2 { [ $out = p1 ] && echo "$upd" || cat ord; } | sed -n $(($(echo "$upd" | wc -l) / 2 + 1))p >>$out done printf 'Part 1: %d\n' $(paste -sd'+' p1 | bc) printf 'Part 2: %d\n' $(paste -sd'+' p2 | bc) Then translated to CL (cleaner, but painful interaction through uiop): (in-package #:q3cpma-user) (named-readtables:in-readtable :q3cpma/readtable) (defparameter *rules* nil) (defparameter *updates* nil) (destructuring-bind (rule-lines update-lines) (list:split-on "" (uiop:read-file-lines *input-path*) :test #'string=) (setf *rules* (mapcar #λ(mapcar #'parse-integer (str:split #\| _)) rule-lines)) (setf *updates* (mapcar #λ(mapcar #'parse-integer (str:split #\, _)) update-lines))) (defun tsort (rules) ;; I'm not writing a topological sort when POSIX has tsort... (let* ((input (apply #'str:join #\Space (mapcar #'princ-to-string (flatten rules)))) (output (uiop:run-program '("tsort") :input (list input) :output :lines))) (mapcar #'parse-integer output))) (defun order (update) (tsort (remove-if-not #λ(subsetp _ update) *rules*))) (iter (for update in *updates*) (for order = (order update)) (if (equal (remove-if-not #λ(member _ order) update) order) (sum (elt update (truncate (length update) 2)) into p1) (sum (elt order (truncate (length order) 2)) into p2)) (finally (format t "Part 1: ~A~%" p1) (format t "Part 2: ~A~%" p2)))

>>40592 A bit more golfing for sh: sed '/^$/,$d; s/|/ /' "$in" >rules sed '1,/^$/d' "$in" | while IFS= read -r update do pat=$(echo "$update" | tr , '\n' | tee upd | paste -sd'|' -) grep -Ex "($pat) ($pat)" rules | tsort >ord grep -Fxf ord upd | cmp -s - ord && out=p1 || out=p2 { [ $out = p1 ] && cat upd || cat ord; } | sed -n $(($(wc -l <upd) / 2 + 1))p >>$out done printf 'Part 1: %d\n' $(paste -sd'+' p1 | bc) printf 'Part 2: %d\n' $(paste -sd'+' p2 | bc)

Gofriend back again. part 1 finished today, decided to use structs halfway through. Here's some of my code. It's still pretty bad but I'm ok with that! And I'm not even going to attempt part2, it looks insane. func (g *guard) moveG(grid []string, turns *int) bool { mY := len(grid) mX := len(grid[0]) switch g.g { case '^': if g.y == 0 { fmt.Printf("reached an edge") return true } if grid[g.y-1][g.x] != '#' { g.y-- *turns++ } else { g.turnG() } case '>': if g.x+1 == mX { fmt.Printf("reached an edge") return true } if grid[g.y][g.x+1] != '#' { g.x++ *turns++ } else { g.turnG() } case 'v': if g.y+1 == mY { fmt.Printf("reached an edge") return true } if grid[g.y+1][g.x] != '#' { g.y++ *turns++ } else { g.turnG() } case '<': if g.x == 0 { fmt.Printf("reached an edge") return true } if grid[g.y][g.x-1] != '#' { g.x-- *turns++ } else { g.turnG() } } return false } func p1(lines []string) int { var gx, gy int for i, y := range lines { gp := indexOfS(y, '^') if gp > 0 { gx = gp gy = i break } } g := guard{ x: gx, y: gy, g: '^', } fmt.Printf("gp: %d %d\n", g.x, g.y) turns := 0 for { line := []rune(lines[g.y]) line[g.x] = 'X' lines[g.y] = string(line) fmt.Printf("guard: %c %d, %d: %d\n", g.g, g.x, g.y, turns) done := g.moveG(lines, &turns) if done { break } } steps := countX(lines) fmt.Printf("unique %d\n", steps) return steps }

>>40602 Lainchan doesn't like tabs, friend. 2nd part really isn't that hard if you brute force it (2s here on SBCL). (in-package #:q3cpma-user) (defparameter *map* (apply #'array-operations:stack-rows* 'standard-char (uiop:read-file-lines *input-path*))) (defparameter *start* (apply #'complex (array:position #\^ *map*))) (define-constant +directions+ (circular-list #c(-1 0) #c(0 1) #c(1 0) #c(0 -1)) :test 'equal) (defmacro map-ref (pos) `(aref *map* (realpart ,pos) (imagpart ,pos))) (defun map-in-bounds-p (pos) (array-in-bounds-p *map* (realpart pos) (imagpart pos))) (defun walk (&key path-table (pos *start*) (dirlist +directions+)) (if path-table ;; Can be provided to minimize GC pressure (clrhash path-table) (setf path-table (make-hash-table))) (symbol-macrolet ((dir (car dirlist)) (next (+ pos dir))) (iter outer (when (member dir (gethash pos path-table)) (leave (values path-table t))) (pushnew dir (gethash pos path-table)) (iter (in outer (while (map-in-bounds-p next))) (while (char= (map-ref next) #\#)) (setf dirlist (cdr dirlist))) (setf pos next) (finally (return-from outer (values path-table nil)))))) (let ((guard-path (walk))) (format t "Part 1: ~A~%" (hash-table-count guard-path)) (format t "Part 2: ~A~%" (iter (initially (remhash *start* guard-path)) (with table = (make-hash-table :size (hash-table-count guard-path))) (for (pos nil) in-hashtable guard-path) (setf (map-ref pos) #\#) (counting (nth-value 1 (walk :path-table table))) (setf (map-ref pos) #\.)))) Nobody else? Not sure I'll continue posting in a ghost town thread.

>>40604 Just go to the 4/g/ if youre fine with cloudflare I would be participating but its a bad time for me

day 7, python f = (lambda t, a, b, p2=0: f(t + b[0], a, b[1:], p2) or f(t * b[0], a, b[1:], p2) or f(int(f'{t}{b[0]}'), a, b[1:], p2) * p2 if b else t == a) p1 = p2 = 0 for ln in open(0).readlines(): a, b = ln.split(':') a = int(a) b = tuple(map(int, b.split())) p1 += a * f(b[0], a, b[1:]) p2 += a * f(b[0], a, b[1:], 1) print(p1, p2)

>>40592 I think that topological sorting is not needed to solve Day 5, regular sorting should be enough. I am not going to prove this, but my solution works using regular sorting, which gives me confidence. The reason I think it works is that given pages A, B, and C, where A < B && B < C, it is not necessary to enforce A < C. I can think of two examples: 1. A sequence of pages that contains A, B, and C. A must come before B, and B -- before C. As a result of a regular sort, A will naturally come before C. 2. A sequence that contains A and C, but not B. Here, the relative order of A and C doesn't matter. E.g., A may come either before or after C.

Code golf version, I also made a properly fast "concat-ints>=0" function not going through strings. (in-package #:q3cpma-user) (defparameter *eqns* (mapcar #λ(destructuring-bind (l r) (str:split #\: _) (cons (read-from-string l) (read:all-from-string r))) (uiop:read-file-lines *input-path*))) (defparameter *operators* (list #'+ #'*)) (defun check (expected nums &optional (acc 0) (op #'+)) (if nums (some #λ(check expected (cdr nums) (funcall op acc (car nums)) _) *operators*) (= expected acc))) (format t "Part 1: ~A~%" (reduce #'+ (remove-if-not #λ(check (car _) (cdr _)) *eqns*) :key #'car)) (format t "Part 2: ~A~%" (let ((*operators* (cons #λ(parse-integer #""_1""_2"") *operators*))) (reduce #'+ (remove-if-not #λ(check (car _) (cdr _)) *eqns*) :key #'car))) >>40605 As someone who left a little bit before GG, I went to check just for giggles. First I didn't find any AoC thread and holy soykaf, this is basically the same as Reddit. >>40607 Pretty clean! But I don't understand the " f(int(f'{t}{b[0]}'), a, b[1:], p2) * p2" line. Why "* p2"? Oh, that's a ternary...

I got some of part 1 with recursion! And yeah I don't really care that lainchan doesn't like tabs, I'm not bothering to replace them. My code being less readable is just a reflection on its already subpar quality I guess. func calibrate(t int, s int, v []int) bool { fmt.Printf("calibrate t:%d s:%d v:%d\n", t, s, v) if len(v) == 1 { if s*v[0] == t || s+v[0] == t { return true } else { return false } } ca := calibrate(t, s+v[0], v[1:]) cm := calibrate(t, s*v[0], v[1:]) if ca || cm { return true } return false } func p1(l1 []int, l2 [][]int) { evals := 0 sum := 0 for i, target := range l1 { if calibrate(target, l2[i][0], l2[i][1:]) { evals++ sum += target } } fmt.Printf("s %d e %d\n", sum, evals) }

>>40609 the function returns true or false when it hits the `t == a` base case i only consider concatenation `int(f'{t}{b[0]}')` for part 2, so i multiply it by false for part 1 think of false as zero here

>>40611 :%s/\t/ /g

>>40613 my editor will change it back when I save the file, kind of unfortunate that lainchan doesn't support tabs. Anyway, got part 2 after an embarrassingly long time being confused why my recursion wasn't working. I was calling calibrate() in calibrate2() since I had just copied it. func calibrate2(t int, s int, v []int) bool { //fmt.Printf("calibrate t:%d s:%d v:%d\n", t, s, v) sv0 := iconcat(s, v[0]) if len(v) == 1 { return s*v[0] == t || s+v[0] == t || sv0 == t } ca := calibrate2(t, s+v[0], v[1:]) cm := calibrate2(t, s*v[0], v[1:]) cc := calibrate2(t, sv0, v[1:]) return ca || cm || cc } func d7p2(l1 []int, l2 [][]int) { sum := 0 for i, target := range l1 { if calibrate2(target, l2[i][0], l2[i][1:]) { sum += target } } fmt.Printf("s %d\n", sum) }

>>40518 >>40519 >>40526 The reason they do this is that OAuth offloads a lot of work surrounding identity verification and not storing unencrypted personally identifiable information. To expect a stupid programming puzzle site that is popular once a year to implement proper auth, hashing, bot protection, etc. is a little ridiculous. I totally get where they're coming from. Idiots are going to send the same username/email/password to their service and now they are legally responsible for that info if they don't implement this sort of authentication method. Anyway, you can still easily find all the exercises and a sufficient test case online, you just won't get graded for speed.

>>40609 Its under the name of /aocg/ or something I participated with them last year, the thread itself is a massive bump over the rest of the catalog, im assuming by virtue of being filled with people who can actually code

Was afraid today was going to get hard, but no, an easy one! (in-package #:q3cpma-user) (load (make-pathname :defaults *load-truename* :name "../grid")) (defparameter *map* (grid-read *input-path*)) (defparameter *antennas* (seq:classify (grid-position-all-if #λ(char/= #\. _) *map*) #λ(grid-ref *map* _))) (defparameter *frequency-model* :part1) (defun antinodes (a1 a2) (let ((a1→a2 (- a2 a1)) (a2→a1 (- a1 a2))) (ecase *frequency-model* (:part1 (list (+ a2 a1→a2) (+ a1 a2→a1))) (:part2 (nconc (iter (for an from (+ a1 a2→a1) by a2→a1) (while (grid-in-bounds-p *map* an)) (collect an)) `(,a1) (iter (for an from (+ a1 a1→a2) by a1→a2) (while (grid-in-bounds-p *map* an)) (collect an))))))) (defun antinodes-for-freq (f) (mapcon (lambda (subl) (mapcan #λ(antinodes (car subl) _) (cdr subl))) (gethash f *antennas*))) (defun all-positions-with-antinode () (remove-duplicates (remove-if-not #λ(grid-in-bounds-p *map* _) (mapcan #'antinodes-for-freq (hash-table:keys *antennas*))))) (format t "Part 1: ~A~%" (length (all-positions-with-antinode))) (format t "Part 2: ~A~%" (let ((*frequency-model* :part2)) (length (all-positions-with-antinode)))) >>40627 I see.

After 5 hours of intense despair caused by multiple off-by-one errors, I can now shower, eat and go to sleep. Have to work tomorrow, after all. A little bird tells me this day will separate the men from the boys. (in-package #:q3cpma-user) (defparameter *files* nil) (defparameter *holes* nil) (iter (for c in-string (uiop:read-file-line *input-path*) with-index i) (for n = (digit-char-p c)) (if (evenp i) (push (cons (/ i 2) n) *files*) (push n *holes*)) (finally (nreversef *files*) (nreversef *holes*))) (defun print-disk (files holes) (iter (for (id . len) in files) (iter (repeat len) (format t "~A" id)) (for h in holes) (iter (repeat h) (format t ".")) (finally (terpri)))) (defun compact () (iter outer (with files = (dlist:make (copy-tree *files*))) (with holes = (copy-list *holes*)) (while (not (dlist:emptyp files))) (for h in holes) (collect (dlist:pop-front files)) (iter (while (and (> h 0) (not (dlist:emptyp files)))) (for (id . len) = (dlist:pop-back files)) (in outer (collect (cons id (min h len)))) (decf h len) (finally (when (< h 0) (dlist:push-back (cons id (- h)) files)))))) (defun defragment () (iter outer (with files = (dlist:make (copy-tree *files*))) (with holes = (dlist:make (copy-tree *holes*))) (with moved = (make-hash-table)) (with last-hole = (- (list-length *files*) 1)) (decf last-hole) (for fc initially (dlist:tail files) then (dlist:prev fc)) (while fc) (for f = (dlist:value fc)) (for (id . len) = f) (when (gethash id moved) (next-iteration)) (iter (for hc initially (dlist:head holes) then (dlist:next hc)) (while hc) (for hi from 0 to last-hole) (when (>= (dlist:value hc) len) ;; Shrink chosen hole (decf (dlist:value hc) len) ;; Enlarge destination hole (incf (dlist:value (dlist:nthcell last-hole holes)) len) ;; "Move" file; actually not, copy it and shrink the old one to nothing (dlist:insert-after (copy-list (dlist:value fc)) files (dlist:nthcell hi files)) ;; Keep the moved file but shrink it to nothing (setf (cdr f) 0) ;; Add a zero-length hole before the moved file (dlist:insert-before 0 holes hc) ;; Remember we moved this file to not move it again (setf (gethash id moved) t) ;; Account for the inserted zero-length hole (incf last-hole) (finish))) (finally (return-from outer (iter (for f in (dlist:to-list files)) (collect f) (for h in (dlist:to-list holes)) (collect (cons 0 h))))))) (defun checksum (files) (iter (for (id . len) in files) (for pos initially 0 then (+ pos len)) (sum (reduce #'+ (iota len :start pos) :key #λ(* id _))))) (format t "Part 1: ~A~%" (checksum (compact))) (format t "Part 2: ~A~%" (checksum (defragment))) Thank god I already had a double-linked list handy.

Today was an easy one (as long as you can code a BFS). If you have trouble with yesterday, it's a nice change of pace. (in-package #:q3cpma-user) (load (make-pathname :defaults *load-truename* :name "../grid")) (defparameter *map* (grid-read *input-path* :key #'digit-char-p :type 'unsigned-byte)) (defconstant +bottom+ 0) (defconstant +summit+ 9) (defun next-nodes (pos) (let ((height (grid-ref *map* pos))) (remove-if-not #λ(and (grid-in-bounds-p *map* _) (= (grid-ref *map* _) (+ height 1))) (mapcar #λ(+ pos _) '(#c(-1 0) #c(0 1) #c(1 0) #c(0 -1)))))) (defun trail-ends (start) (iter (with to-visit = (queue:make (list start))) (while (not (queue:empty-p to-visit))) (for node = (queue:pop to-visit)) (let ((next (next-nodes node))) (cond (next (queue:pushm next to-visit)) ((= (grid-ref *map* node) +summit+) (collect node)))))) (let* ((starts (grid-position-all +bottom+ *map*)) (ends (mapcar #'trail-ends starts))) (format t "Part 1: ~A~%" (reduce #'+ (mapcar #'remove-duplicates ends) :key #'length)) (format t "Part 2: ~A~%" (reduce #'+ ends :key #'length)))

Catching up 2 days at a time. Completed days 8 and 9 today. Day 8 was a breeze. For day 9 I ended up with a different approach for each part. Posting only part 2 of day 9 as it's quite long on its own. haskell -- Day 9. Part 2 readDiskMap :: String -> [Int] readDiskMap s = map digitToInt $ filter isDigit s data Block = U Int Int -- Used size fileId | F Int -- Free size deriving Show maybeFileId (U _ fid) = Just fid maybeFileId _ = Nothing hasFileId fid (U _ fid') = fid == fid' hasFileId _ _ = False hasFree size (F free) = free >= size hasFree _ _ = False putBlock :: Block -> Block -> [Block] putBlock (F free) u@(U used fid) | used > free = error "No free space!" | used == free = [u] | otherwise = [u, F (free - used)] putBlock u@(U _ _) f@(F _) = putBlock f u -- Like concatMap but only for the last element that matches a predicate. -- Nothing if there is no match. maybeReplaceLast :: (a -> Bool) -> (a -> [a]) -> [a] -> Maybe [a] maybeReplaceLast pred f xs = case (break pred xs) of (_, []) -> Nothing (pref, (x : xs')) -> case (maybeReplaceLast pred f xs') of Nothing -> Just $ pref ++ (f x) ++ xs' Just xs'' -> Just $ pref ++ (x : xs'') defrag2 :: [Block] -> [Block] defrag2 blocks = reverse $ defrag2' rblocks (head (mapMaybe maybeFileId rblocks)) where rblocks = (reverse blocks) defrag2' blocks 0 = blocks defrag2' blocks fid = defrag2' blocks' (fid - 1) where blocks' = case (maybeReplaceLast (hasFree bSize) (reverse . putBlock u) rest) of Just bs -> pref ++ [F bSize] ++ bs Nothing -> blocks where (pref, (u@(U bSize _) : rest)) = break (hasFileId fid) blocks checksum2 :: [Block] -> Int checksum2 bs = sum $ zipWith (*) (concatMap unroll bs) [0..] where unroll (F sz) = replicate sz 0 unroll (U sz fid) = replicate sz fid toBlocks :: [Int] -> [Block] toBlocks dmap = zipWith h dmap [0..] where h n idx | even idx = U n (idx `div` 2) | otherwise = F n part2 = part2' <$> readInput 9 part2' = checksum2 . defrag2 . toBlocks . readDiskMap

>>40643 Even if my heart is taken by Lisp and I can't understand most of it, Haskell always look nice. Especially in contrast to SML/(O)Caml. What's that u@ thing, for example? Looks very Perl-esque. What's the single quote I see after function symbols too?

>>40644 The @ sign, when placed between a name and a destructuring pattern, binds the thing that is destructured to that name. In that code, u@(U _ _) binds `u` to the Block matched by `U _ _`. The single quote is just a part of the name, as any other character. This is a common naming convention in Haskell, inspired by mathematical notation, I guess, where functions that have common nature but differ slightly are named thus (e.g., a function's derivative is often named by appending a single tick to the function's name).

>>40550 For mul I did this: mul :: Parser Op mulP = do string "mul(" (a,b) <- integer `sepBy` (char ',') string ")" return $ Mul a b I rolled my own parser combinator lib years ago, but this time I'm just using Parsec.

>>40644 You can use the @ syntax like so: go :: String -> (Int, Char) go s@(x:_) = (length x, x) The pattern (x:_) will match non-empty lists. x will be bound to the head of the string and l to the whole string. The tail is discarded (_).

Day 11, implemented using double-buffered hash tables. (in-package #:q3cpma-user) (defparameter *stones* (read:all-from-file *input-path*)) (defun change-stone (s c dst) (macrolet ((add (n) `(incf (gethash ,n dst 0) c))) (cond ((= 0 s) (add 1)) ((evenp (num:digit-count s)) (multiple-value-bind (q r) (truncate s (expt 10 (/ (num:digit-count s) 2))) (add q) (add r))) (t (add (* s 2024)))))) (defun blink (n) (iter (repeat n) ;; Mandatory double-buffering, stones change all at once (with front = (seq:tally *stones*)) (with back = (make-hash-table)) (clrhash back) (maphash #λ(change-stone _1 _2 back) front) (rotatef front back) (finally (return (reduce #'+ (hash-table-values front)))))) (format t "Part 1: ~A~%" (blink 25)) (format t "Part 2: ~A~%" (blink 75)) >>40651 Interestingly, some guy did day 03 using two parser packages in CL, to compare them: https://github.com/vindarel/bacalisp/blob/master/advent/2024/day03.lisp https://github.com/vindarel/bacalisp/blob/master/advent/2024/day03-parseq.lisp >>40647 >>40652 Thanks for the tip!

>>40517 I was planning on posting my jai solutions, but starting a new job and life has delayed my start. I'm still a couple of days behind so I will be posting two a day and hopefully I get caught up in time as to not spam the thread. I will also be posting some stats about memory usage and number of cpu cycles used. If anyone wants the code that does these benchmarks I can post that to, but here we are the first two days. First time posting code blocks so hopefully the formatting ends up ok. // input allocated 14000 bytes // output allocated 81024 bytes // input executed 0.915 million cycles day1 :: (input: string) -> (part1: int, part2: int) { using Basic; using String; using Sort; using Math; using Hash_Table; as: [..]int; bs: [..]int; rhs := input; while true { ok:, line:, rhs = split_line(rhs); if !ok break; ok=, a_str, b_str := split_from_left(line, #char " "); assert(ok); a:, ok = string_to_int(a_str); assert(ok); b:, ok = string_to_int(b_str); assert(ok); array_add(*as, a); array_add(*bs, b); } assert(as.count == bs.count); id :: x => x; quick_sort(as, id); quick_sort(bs, id); part1 := 0; for 0..as.count-1 part1 += abs(as[it] - bs[it]); freq: Table(int, int); for bs { ptr := table_find_pointer(*freq, it); if ptr then ptr.* += 1; else table_add(*freq, it, 1); } part2 := 0; for as { ptr := table_find_pointer(*freq, it); if ptr then part2 += it * ptr.*; } return part1, part2; } // input allocated 19223 bytes // output allocated 64 bytes // input executed 0.710 million cycles day2 :: (input: string) -> (part1: int, part2: int) { using Basic; Check :: enum { FIRST; SECOND; INCREASING; DECREASING; UNSAFE; }; check :: (state: Check, last: int, current: int) -> Check, int { if #complete state == { case .FIRST; return .SECOND, current; case .SECOND; { if last == current return .UNSAFE, current; if last < current { if current - last > 3 return .UNSAFE, current; return .INCREASING, current; } else { if last - current > 3 return .UNSAFE, current; return .DECREASING, current; } } case .INCREASING; { delta := current - last; if delta < 1 || delta > 3 return .UNSAFE, current; } case .DECREASING; { delta := last - current; if delta < 1 || delta > 3 return .UNSAFE, current; } case .UNSAFE; } return state, current; } rhs := input; part1 := 0; part2 := 0; report : [..]int; state : Check; last : int; while true { ok:, line:, rhs = split_line(rhs); if !ok break; state = .FIRST; array_reset_keeping_memory(*report); while line { current:, ok, line = string_to_int(line); assert(ok); state, last = check(state, last, current); array_add(*report, last); } if state != .UNSAFE then part1 += 1; else for _, skip_index: report { state = .FIRST; for report { if it_index == skip_index continue; state, last = check(state, last, it); if state == .UNSAFE break; } if state != .UNSAFE { part2 += 1; break; } } } part2 += part1; return part1, part2; } Most of these are going to be caveman brute force solutions so don't expect anything crazy. Posting mainly to prove that jai isn't vaporware and to answer questions people might have about it.

>>40660 Why is allocated memory described by 2 different numbers -- "input" and "output"? What is the difference between them? And what does "input" mean in the line that describes the number of execution cycles?

>>40661 The input is just how big the puzzle input file is, output allocated is how much dynamic memory the solution allocated (not including the input file obviously). "input executed" is a mistake! It should be "output executed" and its just the difference between rdtsc() before and after the solution is ran. Loading the file does not contribute to this value.

>>40656 what do you use for data analysis ?

Hated that type of problem last year, still do to this day. (in-package #:q3cpma-user) (load (make-pathname :defaults *load-truename* :name "../grid")) (defparameter *map* (grid-read *input-path* :type 'standard-char)) (define-constant +directions+ '(#c(-1 0) #c(0 1) #c(1 0) #c(0 -1)) :test 'equal) (defun in-region-p (type pos &optional (delta 0)) (and (grid-in-bounds-p *map* pos delta) (char= type (grid-ref *map* pos delta)))) (defun corner-p (type pos dir1 dir2) (match (mapcar #λ(in-region-p type pos _) (list dir1 (+ dir1 dir2) dir2)) ((or (list t nil t) (list nil _ nil)) t))) (defun corner-count (type pos) (count t (mapcar #λ(corner-p type pos _1 _2) +directions+ `(,@(cdr +directions+) ,(car +directions+))))) (defun survey-region (type surveyed pos) ;; Returns (area perimeter corner-count) (cond ((not (in-region-p type pos)) '(0 1 0)) ((grid-ref surveyed pos) '(0 0 0)) (t (setf (grid-ref surveyed pos) t) (apply #'mapcar #'+ (list 1 0 (corner-count type pos)) (mapcar #λ(survey-region type surveyed _) (mapcar #λ(+ pos _) +directions+)))))) (defun segment-garden () (iter (with surveyed = (make-array (array-dimensions *map*) :element-type 'boolean :initial-element nil)) (for start initially 0 then (grid-position nil surveyed :start start)) (while start) (for type = (grid-ref *map* start)) (collect (cons type (survey-region type surveyed start))))) (defun region-price (region &key discount-p) (destructuring-bind (type area perimeter sides) region (* area (if discount-p sides perimeter)))) (let ((regions (segment-garden))) (format t "Part 1: ~A~%" (reduce #'+ regions :key #'region-price)) (format t "Part 2: ~A~%" (reduce #'+ regions :key #λ(region-price _ :discount-p t)))) >>40660 Well, nice to see that it does indeed exist. Would have been truly interested a good 5 years ago, before discovering Lisp. How does it compare with Zig, since these are quite similar? Does it have keyword parameters? What about metaprogramming? How would you do parallel iteration (zip in Python, foreach in Tcl, `(iter (for ...) (for ...)`) in Lisp)? Pattern matching? Does it need a ternary (i.e. does `var = if true 1 else 2` work) or does it have one? >>40663 You're asking me? sh + mawk/gawk + gnuplot usually does the job, but I'm considering taking a look at https://lisp-stat.dev/ one of these days.

Part 2 of Day 11 took a considerable amount of time, when all I had to do was apply memoisation. Instead, I got hooked on the idea of a recursive tree data structure, which led me nowhere. After finally solving the problem, I took some time to generalise memoisation to arbitrary binary functions. The resulting code looks interesting, to say the least. Compared to how I would approach this in Common Lisp, these are completely different worlds. haskell -- Memoisation of results for binary functions. type MemoTable2 a b c = Map.Map (a,b) c -- Result of applying a memoised binary function: updated table and return value. type MemoR2 a b c = (MemoTable2 a b c, c) -- Memoisation environment. type Memo2 a b c = (MemoTable2 a b c -> MemoR2 a b c) -- Type of memoised binary functions. type MemoF2 a b c = a -> b -> Memo2 a b c -- Stores `c` as a result of applying the memoised function to `a` and `b`. returnM :: (Ord a, Ord b) => a -> b -> c -> Memo2 a b c returnM a b c = \tbl -> (Map.insert (a,b) c tbl, c) -- Applies `g` to the result of applying the memoised function to `a` and `b`. -- The returned environment reflects the effects of recursive calls on the table. recM :: (Ord a, Ord b) => (c -> Memo2 a b c) -> MemoF2 a b c -> a -> b -> Memo2 a b c recM g mf a b = \tbl -> case Map.lookup (a,b) tbl of Just c -> (g c) tbl Nothing -> (g c) tbl' where (tbl', c) = (mf a b) tbl -- Provides access to the return value of a memoised function. bindM :: (Ord a, Ord b) => (c -> Memo2 a b c) -> Memo2 a b c -> Memo2 a b c bindM g m = \tbl -> let (tbl', c) = m tbl in (g c) tbl' foldM :: (Ord a, Ord b) => (c -> c -> c) -> c -> MemoF2 a b c -> [(a,b)] -> Memo2 a b c foldM g c0 mf args = \tbl -> foldl' h (tbl,c0) args where h (tbl,c) (a,b) = (tbl', g c c') where (tbl', c') = (recM (returnM a b) mf a b) tbl -- Application of a memoisation environment. -- Starts with an empty table, and returns the final value produced by the environment. applyM :: (Ord a, Ord b) => Memo2 a b c -> c applyM m = snd $ m Map.empty -- Memoised version of `count`. countM :: MemoF2 Integer Integer Integer countM x 0 = returnM x 0 1 countM x n = bindM (\c -> returnM x n c) m where m = foldM h 0 countM (zip (evolve x) (repeat (n-1))) where h s yc = s + yc -- Counts the number of stones that `x` turns into after blinking `n` times. count x n = applyM (countM x n) -- Counts the number of stones that `xs` turn into after blinking `n` times. countAll xs n = applyM $ foldM (+) 0 countM (zip xs (repeat n)) evolve :: Integer -> [Integer] evolve 0 = [1] evolve n | even c = [x, y] | otherwise = [n * 2024] where c = countDigits n (x, y) = splitNumber n c countDigits :: Integer -> Int countDigits n = h n 1 where h n c = if n `div` 10 == 0 then c else h (n `div` 10) (c+1) splitNumber :: Integer -> Int -> (Integer, Integer) splitNumber n c = (n `div` h, n `mod` h) where h = (10 ^ (c `div` 2)) readNumbers = parseValue inputParser inputParser = separatedByParser (charParser ' ') integerParser part1 = part1' <$> readInput 11 part1' s = countAll (readNumbers s) 25 part2 = part2' <$> readInput 11 part2' s = countAll (readNumbers s) 75

First day where I needed maths. Hope there won't be many of these, I'm doing the AoC, not project Euler. (in-package #:q3cpma-user) (defun parse-machine (string) (mapcar #'parse-integer (cl-ppcre:all-matches-as-strings "\\d+" string))) (defparameter *machines* (mapcar #'parse-machine (str:split #"\n\n" (uiop:read-file-string *input-path*)))) (defun solve (machine) (destructuring-bind (ax ay bx by px py) machine (let* ((a (/ (- (* px by) (* py bx)) (- (* ax by) (* ay bx)))) (b (/ (- px (* a ax)) bx))) (and (integerp a) (integerp b) (list a b))))) (defun correct (machine) (let ((new (copy-list machine))) (incf (fifth new) 10000000000000) (incf (sixth new) 10000000000000) new)) (defun cost (solution) (if solution (+ (* 3 (car solution)) (cadr solution)) 0)) (format t "Part 1: ~A~%" (reduce #'+ (mapcar #'solve *machines*) :key #'cost)) (format t "Part 2: ~A~%" (reduce #'+ (mapcar #'solve (mapcar #'correct *machines*)) :key #'cost)) >>40665 Still looking good, even if memoization wasn't necessary in this case. If something like https://www.simplehaskell.org/ took flight and cleaned the dumpster fire that is normal Haskell (there's a standard but nobody uses anything else but GHC and its bazillion extensions, the standard library itself is even more baroque and full of cruft than ANSI CL), same way that SML truly needs successor ML, I'd look at it. Also, I don't know if I'm being Lisp-brained, but I can barely stand operators as something syntactically and/or conceptually different from functions; give me my (+ 0 1 2)s!

>>40664 >How does it compare with Zig, since these are quite similar? Haven't used that much zig so I couldn't tell you to be honest. They are both "C++ Killer" languages and their differences boil down to the exact C++ subset their creator prefers. >Does it have keyword parameters? yes >What about metaprogramming? There is very rich support for metaprogramming. On the most basic level there are two kinds of metaprogramming that can be done, compile-time execution and compiler-interception. Any code prefixed with a #run directive is executed at compile-time and the there is the #insert directive which inserts compile-time generated program text or syntax tree into that point in the program. Compiler interception works by having the compiler as a library at compile time and allowing compilation tasks launched programmatically to listen to events emitted by the compiler. Events are raised when files get loaded, modules get imported, expressions are typechecked, the phase of compilation has changed, among other things. Any code passed through a message can also be arbitrarily rewritten on the syntax tree level. Hopefully this answers the question. >How would you do parallel iteration (zip in Python, foreach in Tcl, `(iter (for ...) (for ...)`) in Lisp)? There is nothing built in or in the standard modules, but it would be trivial to implement with the current macro system. >Pattern matching? Nope. But again as long as something parses as jai code, you can introspect and rewrite the syntax tree arbitrarily so writing macros for pattern matching tagged unions or structures can be implemented. I have implemented such pattern matching macros myself without too much fuss. >Does it need a ternary (i.e. does `var = if true 1 else 2` work) or does it have one? There is very much a delineation between statements and expressions if that's what you're asking, and there is a ternary operator ifx (you can see an example of it in my day 3 implementation) // input allocated 17700 bytes // output allocated 0 bytes // output executed 10.754 million cycles day3 :: (input: string) -> (part1: int, part2: int) { using Basic; using String; using Math; rhs := input; part1 := 0; part2 := 0; enabled := true; while rhs { found_mul, mul_lhs, mul_rhs := split_from_left(rhs, "mul("); found_do, do_lhs, do_rhs := split_from_left(rhs, "do()"); found_dont, dont_lhs, dont_rhs := split_from_left(rhs, "don't()"); m := min( ifx found_mul then mul_lhs.count else input.count, ifx found_do then do_lhs.count else input.count, ifx found_dont then dont_lhs.count else input.count, ); if m == mul_lhs.count { rhs = mul_rhs; a:, ok:, rhs = string_to_int(rhs); if !ok || a > 999 || a < 0 continue; chr := rhs[0]; rhs = advance(rhs); if chr != #char "," continue; b:, ok, rhs = string_to_int(rhs); if !ok || b > 999 || b < 0 continue; chr = rhs[0]; rhs = advance(rhs); if chr != #char ")" continue; part1 += a * b; if enabled then part2 += a * b; } else if m == do_lhs.count { rhs = do_rhs; enabled = true; } else if m == dont_lhs.count { rhs = dont_rhs; enabled = false; } else if m == input.count { break; } } return part1, part2; } // input allocated 19740 bytes // output allocated 2240 bytes // output executed 1.573 million cycles day4 :: (input: string) -> (part1: int, part2: int) { using Basic; grid_size :: 140; grid: [..]string; array_reserve(*grid, grid_size); rhs := input; while true { ok:, line:, rhs = split_line(rhs); if !ok break; array_add(*grid, line); } Direction :: enum { uu; ul; ur; dd; dl; dr; ll; rr; } move :: (dir: Direction, row: int, col: int) -> (ok: bool, new_row: int, new_col: int) { new_row: int = ---; new_col: int = ---; if #complete dir == { case .uu; #through; case .ul; #through; case .ur; if row then new_row = row-1; else return false, row, col; case .dd; #through; case .dl; #through; case .dr; if row < grid_size-1 then new_row = row + 1; else return false, row, col; case .ll; #through; case .rr; new_row = row; } if #complete dir == { case .ur; #through; case .rr; #through; case .dr; if col < grid_size-1 then new_col = col + 1; else return false, row, col; case .ul; #through; case .ll; #through; case .dl; if col then new_col = col-1; else return false, row, col; case .uu; #through; case .dd; new_col = col; } return true, new_row, new_col; } part1 := 0; xmas :: "XMAS"; start, end :: #run enum_range(Direction); for row, row_index: grid for starting_index, col_index: row for start..end { dir, r, c := cast(Direction) it, row_index, col_index; for xmas { if grid[r][c] != it break; if it_index == xmas.count - 1 then part1 += 1; else { ok:, r, c = move(dir, r, c); if !ok break; } } } part2 := 0; for row, row_index: grid for start, col_index: row if start == #char "A" for Direction.[.ul, .ur, .dl, .dr] { ok, r, c := move(it, row_index, col_index); if !ok || grid[r][c] != #char "M" continue; opposite: Direction = ---; orthog_a: Direction = ---; orthog_b: Direction = ---; if it == { case .ul; opposite = .dr; orthog_a = .ur; orthog_b = .dl; case .ur; opposite = .dl; orthog_a = .dr; orthog_b = .ul; case .dl; opposite = .ur; orthog_a = .ul; orthog_b = .dr; case .dr; opposite = .ul; orthog_a = .dl; orthog_b = .ur; }; ok, r, c = move(opposite, row_index, col_index); if !ok || grid[r][c] != #char "S" continue; ok, r, c = move(orthog_a, row_index, col_index); if !ok continue; to_find: u8 = ---; if grid[r][c] == { case #char "M"; to_find = #char "S"; case #char "S"; to_find = #char "M"; case; continue; } ok, r, c = move(orthog_b, row_index, col_index); if !ok || grid[r][c] != to_find continue; part2 += 1; } part2 /= 2; return part1, part2; }

>>40664 >How would you do parallel iteration (zip in Python, foreach in Tcl, `(iter (for ...) (for ...)`) in Lisp)?

Powering through... Completed Day 12. haskell type Pos = (Int,Int) type Grid = Array Pos Char inBounds pos grid = inRange (bounds grid) pos sameType grid pos1 pos2 = maybe False id (liftM2 (==) (grid `at` pos1) (grid `at` pos2)) neighbours :: Pos -> [Pos] neighbours (r,c) = [(r+1,c), (r-1,c), (r,c+1), (r,c-1)] sameNeighbours :: Pos -> Grid -> [Pos] sameNeighbours pos grid = filter (sameType grid pos) (neighbours pos) isAdjacent :: Pos -> Pos -> Bool isAdjacent (r1,c1) (r2,c2) = ((r1 == r2) && (1 == (abs (c1 - c2)))) || ((c1 == c2) && (1 == (abs (r1 - r2)))) -- aka Region type Shape = [Pos] area shape _ = length shape perim :: Shape -> Grid -> Int perim shape grid = sum $ map countForeign shape where countForeign pos = length $ filter (not . (sameType grid pos)) (neighbours pos) sides :: Shape -> Grid -> [Pos] sides shp grid = concatMap id $ zipWith ownEdges pairs (drop 1 (tails pairs)) where pairs = map (\pos -> (pos, edges pos)) shp edges pos = filter (not . (sameType grid pos)) (neighbours pos) ownEdges (pos, es) rest = filter (not . (isShared adjRest)) es where adjRest = filter (isAdjacent pos . fst) rest isShared rest e = isJust $ find (isAdjacent e) (concatMap snd rest) countSides = (length .) . sides findShapes :: Grid -> [Shape] -- Assign a shape ID to each position, then group positions into shapes by ID. -- Convoluted, but it works. findShapes grid = map snd $ Map.toList $ Map.fromListWith (++) (map (\(pos, s) -> (s, [pos])) (Map.assocs table)) -- table of (position, shape id) where table = h (drop 1 (indices grid)) (Set.singleton (head (indices grid))) 0 Map.empty h [] shp i tbl = tbl h poss@(posH:posT) shp i tbl = case filter (\x -> Set.notMember x shp) (concatMap (\x -> sameNeighbours x grid) (Set.toList shp)) of [] -> case dropWhile (\x -> Map.member x tbl) poss of [] -> tbl' (posH':posT') -> h posT' (Set.singleton posH') (i+1) tbl' nbrs -> h poss (Set.union shp (Set.fromList nbrs)) i tbl where tbl' = Map.union tbl (Map.fromSet (const i) shp) readGrid :: String -> Grid readGrid s = listArray ((1,1), (h,w)) (concat (lines s)) where h = length (lines s) w = length (head (lines s)) part1' s = sum $ map (\s -> (area s grid) * (perim s grid)) shapes where shapes = findShapes grid grid = readGrid s part2' s = sum $ map (\s -> (area s grid) * (countSides s grid)) shapes where shapes = findShapes grid grid = readGrid s

Day 14, was fun trying to find an image without knowing its appearance. (in-package #:q3cpma-user) (defun parse-robot (line) (list:nchunk 2 (mapcar #'parse-integer (cl-ppcre:all-matches-as-strings "-?\\d+" line)))) (defparameter *robots* (mapcar #'parse-robot (uiop:read-file-lines *input-path*))) (define-constant +room-dimensions+ '(101 103) :test 'equal) (define-constant +quadrant-borders+ (mapcar #λ(truncate _ 2) +room-dimensions+) :test 'equal) (defun move (robot) (rplaca robot (mapcar #λ(mod (+ _1 _2) _3) (car robot) (cadr robot) +room-dimensions+))) (defun simulate (stop-pred) (iter (with robots-copy = (copy-tree *robots*)) (for cycle from 0) (until (funcall stop-pred cycle robots-copy)) (mapc #'move robots-copy) (finally (return robots-copy)))) (defun which-quadrant (robot) (match (mapcar #λ(signum (- _1 _2)) (car robot) +quadrant-borders+) ((list -1 -1) :NW) ((list 1 -1) :NE) ((list 1 1) :SE) ((list -1 1) :SW))) (defun safety-factor (robots) (reduce #'* (let ((res (seq:classify robots #'which-quadrant))) (remhash nil res) (hash-table:values res)) :key #'length)) (defun christmas-tree-p (cycle robots) (flet ((print-room (robots) (array:print-matrix (let ((canvas (make-array +room-dimensions+ :element-type 'standard-char :initial-element #\Space))) (mapc #λ(setf (apply #'aref canvas (car _)) #\*) robots) canvas)))) (iter (with ytally = (make-array (car +room-dimensions+) :element-type 'fixnum :initial-element 0)) (with xtally = (make-array (cadr +room-dimensions+) :element-type 'fixnum :initial-element 0)) (for ((x y) nil nil) in robots) (incf (aref ytally x)) (incf (aref xtally y)) (finally (when (and (> (standard-deviation ytally) 5) (> (standard-deviation xtally) 5)) (print-room robots) (when (y-or-n-p "You seein' a Christmas tree there?") (format t "Part 2: ~A~%" cycle) (return t))))))) (format t "Part 1: ~A~%" (safety-factor (simulate #2λ(<= 100 _1)))) (simulate #'christmas-tree-p) >>40667 Thanks for answering my question. >>Does it have keyword parameters? >yes Wow, that's good and quite rare in low-level languages! We're talking about the same thing, right? Optional, named at call-site and possibly order insensitive? >>What about metaprogramming? >...Any code passed through a message can also be arbitrarily rewritten on the syntax tree level. Hopefully this answers the question. Huh. Will probably have to see what a procedural macro looks like, when it becomes public. Sounds pretty cool, like this. >>How would you do parallel iteration (zip in Python, foreach in Tcl, `(iter (for ...) (for ...)`) in Lisp)? >There is nothing built in or in the standard modules, but it would be trivial to implement with the current macro system. That's a minus to me, having to reinvent the wheel ensures nobody will speak the same language until a library to implement better iteration becomes the overwhelming consensus. And then you're depending on an extension that should have been standard. >>Pattern matching? >Nope. But again as long as something parses as jai code, you can introspect and rewrite the syntax tree arbitrarily so writing macros for pattern matching tagged unions or structures can be implemented. I have implemented such pattern matching macros myself without too much fuss. Well yeah, but proper, optimized pattern matching is a bit more involved than that: it's basically writing a compiler (cf https://github.com/guicho271828/trivia/tree/master/balland2006). >>Does it need a ternary (i.e. does `var = if true 1 else 2` work) or does it have one? >There is very much a delineation between statements and expressions if that's what you're asking, and there is a ternary operator ifx (you can see an example of it in my day 3 implementation) Well, I'll go see elsewhere. One of the worst mistakes of C inspired languages (including Python), in my opinion. Hope it won't turn out to be just another Go/Hare. >>40674 Really love how the terseness of function declarations encourage you to name even the smallest one. Really improve readability over lambdas everywhere.

>>40676 > We're talking about the same thing, right? Optional, named at call-site and possibly order insensitive? Yup, explicitly named parameters can be in any order and there are default arguments. > That's a minus to me, having to reinvent the wheel ensures nobody will speak the same language until a library to implement better iteration becomes the overwhelming consensus. And then you're depending on an extension that should have been standard. Going to have to side with >>40669 here. I've never felt compelled to reach for complex iterators even in languages that have them built in when basic looping constructs can do the job. > Well yeah, but proper, optimized pattern matching is a bit more involved than that: it's basically writing a compiler That may be true, but the point is that the metaprogramming system allows you inspect and modify the program in a way that makes all of the things lispers love so much like pattern matching and object systems doable with enough elbow grease. > One of the worst mistakes of C inspired languages (including Python), in my opinion. Eh, the creator has mentioned potentially switching to be purely expression based, but since a lot of the issues that come from the distinction in C are already fixed so it isn't high priority atm. You can still have a block that evaluates to an expression if you do something like x := ifx true { foo(); bar(); baz;() } runs all of the procedures and returns the result of baz to the expression. A lot of the syntax jank has accrued over the years with the justification that there will be a "major syntax overhaul" at some point in the future. Purely expression based syntaxes are nice, but it's such a minor thing to me I can't be bothered to care when the underlying semantics are so good. And now for days 5 and 6. If all goes according to plan I will be fully caught up tomorrow (just finished day 12) // input allocated 16132 bytes // output allocated 34944 bytes // output executed 3.794 million cycles day5 :: (input: string) -> (part1: int, part2: int) { using Basic; using String; using Hash_Table; order: Table(int, [..]int); rhs := input; while true { ok:, line:, rhs = split_line(rhs); assert(ok); if !line break; a:, ok, line = string_to_int(line); assert(ok); advance(*line); // the bar b:, ok, line = string_to_int(line); assert(ok); ptr := table_find_pointer(*order, a); dumb: [..]int; if !ptr then ptr = table_add(*order, a, dumb); array_add(ptr, b); } check :: (order: *Table(int, [..]int), before: []int, value: int) -> bool, int { should_be_later, found := table_find(order, value); if found for should_be_later { failed, index := array_find(before, it); if failed return false, index; } return true, -1; } part1 := 0; part2 := 0; update: [..]int; while true { ok:, line:, rhs = split_line(rhs); if !ok break; assert(xx line); array_reset_keeping_memory(*update); correct := true; while true { a:, ok, line = string_to_int(line); if !ok then break; if line then advance(*line); // the comma correct &&= check(*order, update, a); array_add(*update, a); } if correct { assert(xx update.count % 2 == 1); part1 += update[update.count / 2]; } else { before: []int = update; keep_going := true; while keep_going { keep_going = false; for < _, it_index: update { before.count = it_index; ok, index := check(*order, before, update[it_index]); if !ok { keep_going = true; update[it_index], update[index] = swap(update[it_index], update[index]); } } } assert(xx update.count % 2 == 1); part2 += update[update.count / 2]; } } return part1, part2; } // input allocated 17030 bytes // output allocated 998792 bytes // output executed 1746.391 million cycles day6 :: (input: string) -> (part1: int, part2: int) { using Basic; using Hash_Table; Tile :: enum u8 { PATH; BLOCK; }; Direction :: enum { UP; RIGHT; DOWN; LEFT; } Position :: struct { row: u32; col: u32; }; rotate :: (dir: Direction) -> Direction { return xx ((cast(int) dir + 1) % 4); } get :: (using pos: Position) -> *Tile #expand { assert(row >= 0 && row < grid_rows); assert(col >= 0 && col < grid_cols); return *grid[row*grid_cols + col]; } move :: (dir: Direction, using pos: Position) -> (ok: bool, new_pos: Position) #expand { if #complete dir == { case .UP; if row then return true, .{row-1, col}; else return false, .{row, col}; case .LEFT; if col then return true, .{row, col-1}; else return false, .{row, col}; case .DOWN; if row < grid_rows-1 then return true, .{row+1, col}; else return false, .{row, col}; case .RIGHT; if col < grid_cols-1 then return true, .{row, col+1}; else return false, .{row, col}; } } guard: struct { dir: Direction; pos: Position; } initial_guard: type_of(guard); grid_cols: u32; grid_rows: u32; rhs := input; while true { ok:, line:, rhs = split_line(rhs); if !ok break; assert(xx line); grid_rows += 1; if grid_cols then assert(grid_cols == line.count); else grid_cols = xx line.count; } grid := NewArray(grid_rows*grid_cols, Tile, initialized = false); rhs = input; i := cast(u32) 0; for input { if it == { case #char "^"; using initial_guard; pos.row, pos.col, dir = i / grid_cols, i % grid_cols, Direction.UP; #through; case #char "."; grid[i] = .PATH; case #char "#"; grid[i] = .BLOCK; case #char "\n"; continue; case; crash("`%`", string.{1, *it}); } i += 1; } occupied: Table(Key_Type = Position, Value_Type = void, hash_bytes, comp_bytes); guard = initial_guard; while true { using guard; if !table_find_pointer(*occupied, pos) then table_add(*occupied, pos, the_void); ok, new_pos := move(dir, pos); if !ok break; if #complete get(new_pos).* == { case .BLOCK; dir = rotate(dir); case .PATH; pos = new_pos; } } part1 := occupied.count; path: Table(type_of(guard), void, hash_bytes, comp_bytes); part2 := 0; i = 0; max_turns := 0; for _, it: occupied { i += 1; old_value := get(it).*; assert(old_value == .PATH); get(it).* = .BLOCK; defer get(it).* = old_value; table_reset(*path); guard = initial_guard; while true { using guard; if table_find_pointer(*path, guard) { part2 += 1; break; } table_add(*path, guard, the_void); ok, new_pos := move(dir, pos); if !ok break; if #complete get(new_pos).* == { case .BLOCK; dir = rotate(dir); case .PATH; pos = new_pos; } } } return part1, part2; }

Day 13 completed. Moving on to the next one. haskell mapBoth f (x,y) = (f x, f y) type Button = (Integer,Integer) -- (x,y) type Prize = (Integer,Integer) -- (x,y) data Machine = Machine { buttonA :: Button, buttonB :: Button, prize :: Prize } deriving Show inputParser = separatedByParser (stringParser "\n\n") machineParser machineParser = do btnA <- (buttonParser 'A') charParser '\n' btnB <- (buttonParser 'B') charParser '\n' prize <- prizeParser return (Machine btnA btnB prize) buttonParser c = do stringParser "Button " charParser c stringParser ": X+" x <- integerParser stringParser ", Y+" y <- integerParser return (x,y) prizeParser = do stringParser "Prize: X=" x <- integerParser stringParser ", Y=" y <- integerParser return (x,y) parseInput = parseValue inputParser type Point = (Rational,Rational) -- y = ax + c type Line = (Rational,Rational) -- (a,c), i.e. (slope, intercept) -- Get the numerator if denominator is 1. onlyNumerator :: Rational -> Maybe Integer onlyNumerator r | (denominator r) == 1 = Just (numerator r) | otherwise = Nothing intersect :: Line -> Line -> Maybe Point intersect (a,c) (b,d) | a == b = Nothing -- parallel | otherwise = Just (x,y) where x = (d - c) / (a - b) y = a * x + c play :: (Integer -> Integer -> Bool) -> Machine -> Maybe (Integer,Integer) play pred (Machine (xa,ya) (xb,yb) (xp,yp)) = (intersect lineX lineY) >>= fin where lineX = mkLine xa xb xp lineY = mkLine ya yb yp fin (a,b) = liftM2 (,) (onlyNumerator a) (onlyNumerator b) >>= (\(a,b) -> if pred a b then Just (a,b) else Nothing) -- (xk + yk + c) => (y = ax + c) mkLine xk yk c = (negate (xk % yk), c % yk) cost as bs = as*3 + bs part1' s = sum $ map (uncurry cost) $ mapMaybe (play checkMaxPresses) (parseInput s) where checkMaxPresses a b = a <= 100 && b <= 100 part1 = part1' <$> readInput 13 part2' s = sum $ map (uncurry cost) $ mapMaybe (play unlimitedPresses) (map (mapPrize (mapBoth (+ 10000000000000))) machines) where machines = parseInput s mapPrize f m = m { prize = f (prize m) } unlimitedPresses _ _ = True part2 = part2' <$> readInput 13 >>40666 Having spent much more time programming in Lisp than in Haskell, I sometimes write incorrect Haskell when operators are involved. In this regard, I appreciate the value of S-expressions. The same could be said about indentation, as I still haven't gotten used to Haskell's.

day 15, python i decided to rotate the grid on each step so that i only need to consider the case where the robot moves right plus some logic for vertical or horizontal for the vertical case i do a dfs and check if all leaf nodes can move; if so, then i dfs again and shift each node by 1 had to use pen and paper to check how rotations affect joining '[' and ']' characters, but otherwise a fairly straightforward day ''' > Measure-Command { cat .\input.txt | python .\aoc.py | Out-Default } 1487337 1521952 Days : 0 Hours : 0 Minutes : 0 Seconds : 7 Milliseconds : 69 Ticks : 70690900 TotalDays : 8.18181712962963E-05 TotalHours : 0.00196363611111111 TotalMinutes : 0.117818166666667 TotalSeconds : 7.06909 TotalMilliseconds : 7069.09 ''' def pos(g: list) -> tuple: for r in range(len(g)): for c in range(len(g[0])): if g[r][c] == '@': return (r, c) def rot(g: list, n: int) -> list: if not n: return g g = [list(x[::-1]) for x in zip(*g)] return rot(g, n - 1) def horizontal(g: list, p: tuple) -> None: (r, c) = p tmp = '.' + g[r][c] for cc in range(c + 1, len(g[0])): match x := g[r][cc]: case 'O' | '[' | ']': tmp += x continue case '#': return for i in range(len(tmp)): g[r][c + i] = tmp[i] break def vertical(g: list, p: tuple, mov: chr) -> None: (r, c) = p def dfs(r: int, c: int, safe: bool) -> bool: cc = c + 1 match g[r][cc]: case '#': ret = False case '.': ret = True case '[': ret = (dfs(r, cc, safe) and dfs(r + 1 if mov == '^' else r - 1, cc, safe)) case ']': ret = (dfs(r, cc, safe) and dfs(r - 1 if mov == '^' else r + 1, cc, safe)) if safe: g[r][cc] = g[r][c] g[r][c] = '.' return ret return dfs(r, c, dfs(r, c, False)) warehouse, movements = open(0).read().strip().split('\n\n') p1map = [list(x) for x in warehouse.split('\n')] p2map = [list(''.join(['[]' if y == 'O' else '@.' if y == '@' else y + y for y in x])) for x in warehouse.split('\n')] movs = movements.replace('\n', '') for i, mov in enumerate(movs): p1map = rot(p1map, '>^<v'.index(mov)) p2map = rot(p2map, '>^<v'.index(mov)) horizontal(p1map, pos(p1map)) p = pos(p2map) horizontal(p2map, p) if mov in "<>" else vertical(p2map, p, mov) p1map = rot(p1map, '>v<^'.index(mov)) p2map = rot(p2map, '>v<^'.index(mov)) gps = lambda g: sum([sum([r * 100 + c for c in range(len(g[0])) if g[r][c] in 'O[']) for r in range(len(g))]) print(gps(p1map)) print(gps(p2map))

>>40699 here's my input if anyone wants to debug using my answers: https://0x0.st/XFJV.txt

>>40699 >>40700 golfed a, b = open(0).read().strip().split('\n\n') a = a.split('\n') p1map = list(map(list, a)) p2map = [list(''.join(['[]' if y == 'O' else '@.' if y == '@' else y * 2 for y in x])) for x in a] pos = lambda g: [(r, c) for r, x in enumerate(g) for c, y in enumerate(x) if y == '@'][0] gps = lambda g: sum(r*100 + c for r, x in enumerate(g) for c, y in enumerate(x) if y in 'O[') rot = lambda g, n: rot([list(x[::-1]) for x in zip(*g)], n - 1) if n else g def horiz(g, r, c): tmp = '.' + g[r][c] for cc in range(c + 1, len(g[0])): match x := g[r][cc]: case 'O' | '[' | ']': tmp += x continue case '#': return for i in range(len(tmp)): g[r][c + i] = tmp[i] break def verti(g, r, c, mov): def dfs(r, c, safe): cc = c + 1 match g[r][cc]: case '#': ret = 0 case '.': ret = 1 case '[': ret = dfs(r, cc, safe) and dfs(r + 1 if mov == '^' else r - 1, cc, safe) case ']': ret = dfs(r, cc, safe) and dfs(r - 1 if mov == '^' else r + 1, cc, safe) if safe: g[r][cc] = g[r][c] g[r][c] = '.' return ret dfs(r, c, dfs(r, c, 0)) for mov in b.replace('\n', ''): p1map = rot(p1map, '>^<v'.index(mov)) p2map = rot(p2map, '>^<v'.index(mov)) r, c = pos(p1map) horiz(p1map, r, c) r, c = pos(p2map) horiz(p2map, r, c) if mov in '<>' else verti(p2map, r, c, mov) p1map = rot(p1map, '>v<^'.index(mov)) p2map = rot(p2map, '>v<^'.index(mov)) print(gps(p1map), gps(p2map))

Lost too much time on a stupid mistake (realpart -> imagpart) that made me watch like a few hundred frames of retarded robot moving boxes. But well, what would be the AoC without hair-pulling? (in-package #:q3cpma-user) (load (make-pathname :defaults *load-truename* :name "../grid")) (defparameter *map* nil) (defparameter *moves* nil) (destructuring-bind (s1 s2) (str:split #"\n\n" (uiop:read-file-string *input-path*)) (setf *map* (grid-read s1 :type 'standard-char) *moves* (hash-table:keys-to-values (coerce (delete #\Newline s2) 'list) (hash-table:pair '(#\^ #\> #\v #\<) +orth-directions+)))) (defun move-cell (map from to) (rotatef (grid-ref map from) (grid-ref map to)) t) ;; Signals a successful move to simulate (defun execute-move-p1 (pos dir map) (case (grid-ref map pos) (#\. t) (#\# nil) (t (when (execute-move-p1 (+ pos dir) dir map) (move-cell map pos (+ pos dir)))))) ;; Can't vertically move boxes like in part 1 (while unwinding the recursive call stack), do a full ;; check _then_ move the visited cells starting from the furthest ones (defun execute-move-p2-vert (pos dir map) (let ((visited)) (labels ((move-possible-p (pos) (case (grid-ref map pos) (#\. t) (#\# nil) (t (let ((other-half (+ pos (case (grid-ref map pos) (#\[ #c(0 1)) (#\] #c(0 -1)))))) (pushnew pos visited) (pushnew other-half visited) (and (move-possible-p (+ pos dir)) (move-possible-p (+ other-half dir)))))))) (case (grid-ref map pos dir) (#\. (move-cell map pos (+ pos dir))) ((#\[ #\]) (when (move-possible-p (+ pos dir)) (misc:sortf visited (if (= dir #c(-1 0)) #'< #'>) :key #'realpart) (mapc #λ(move-cell map _ (+ _ dir)) visited) (move-cell map pos (+ pos dir)))))))) (defun execute-move-p2 (pos dir map) (if (/= (realpart dir) 0) (execute-move-p2-vert pos dir map) (execute-move-p1 pos dir map))) (defun simulate (map move-fun) (iter (with map-copy = (copy-array map)) (with pos = (grid-position #\@ map-copy)) (for move in *moves*) (when (funcall move-fun pos move map-copy) (incf pos move)) (finally (return map-copy)))) (defun gps-score (map) (iter _ (for y below (array-dimension map 0)) (iter (for x below (array-dimension map 1)) (when (member (aref map y x) '(#\O #\[)) (in _ (sum (+ (* 100 y) x))))))) (defun widen-map (map) (make-array (list (array-dimension map 0) (* (array-dimension map 1) 2)) :element-type 'standard-char :initial-contents (mapcar #λ(mapcan #λ(case _ (#\# (list #\# #\#)) (#\O (list #\[ #\])) (#\. (list #\. #\.)) (#\@ (list #\@ #\.))) (coerce _ 'list)) (grid-rows map)))) (format t "Part 1: ~A~%" (gps-score (simulate *map* #'execute-move-p1))) (format t "Part 2: ~A~%" (gps-score (simulate (widen-map *map*) #'execute-move-p2))) The good thing is that it gives me ideas for my utils' TODO. Here, I truly lament CL's poor support for multidimensional arrays (well, better than other languages that must vectors of vectors, I guess) and plan on writing me a way to generate a list of coordinates to map/loop over and some slicing functions. >>40698 Since you seem to know a bit of both worlds, did you look at Idris 2? From an outsider PoV, it seems like a cleaner Haskell in some regards (minus the laziness). >>40702 Definitely cool if convoluted approach!

// input allocated 24776 bytes // output allocated 208 bytes // output executed 56340.850 million cycles day7 :: (input: string) -> (part1: int, part2: int) { using Basic; using String; using Math; rhs := input; values: [..]int; part1 := 0; part2 := 0; sb: String_Builder; while true { ok:, line:, rhs = split_line(rhs); if !ok break; assert(xx line); result:, ok, line = string_to_int(line); advance(*line); // colon array_reset_keeping_memory(*values); while true { val:, ok, line = string_to_int(line); if !ok break; array_add(*values, val); } ops_needed := values.count-1; permutations := cast(int) pow(3, xx ops_needed); for i: 0..permutations-1 { acc := values[0]; used_concat := false; for j: 0..ops_needed-1 { value := values[j+1]; if (i / cast(int)pow(3, xx j)) % 3 == { case 0; acc *= value; case 1; acc += value; case 2; { used_concat = true; print(*sb, "%0%", acc, value); mark := get_temporary_storage_mark(); acc = string_to_int(builder_to_string(*sb)); set_temporary_storage_mark(mark); } } } if acc == result { if !used_concat then part1 += result; part2 += result; break; } } } return part1, part2; } // input allocated 2550 bytes // output allocated 48768 bytes // output executed 9.019 million cycles day8 :: (input: string) -> (part1: int, part2: int) { using Basic; using Hash_Table; Position :: struct { row, col: s32; }; grid_size: Position; rhs := input; while true { ok:, line:, rhs = split_line(rhs); if !ok break; assert(xx line); if grid_size.col then assert(grid_size.col == line.count); else grid_size.col = xx line.count; grid_size.row += 1; } get :: (using pos: Position) -> *u8 #expand { assert(row >= 0 && row < grid_size.row, "row % is out of bounds", row); assert(col >= 0 && col < grid_size.col, "col % is out of bounds", col); return *input[row * (grid_size.row+1) + col]; } antinodes: Table(Position, void, hash_bytes, comp_bytes); for row: 0..grid_size.row-1 for col: 0..grid_size.col-1 { chr := get(.{row, col}).*; if chr == #char "." continue; for test_row: 0..grid_size.row-1 for test_col: 0..grid_size.col-1 if get(.{test_row, test_col}).* == chr && (row != test_row) && (col != test_col) { delta := Position.{row-test_row, col-test_col}; new_pos := Position.{row+delta.row, col+delta.col}; if !table_find_pointer(*antinodes, new_pos) && new_pos.row >= 0 && new_pos.row < grid_size.row && new_pos.col >= 0 && new_pos.col < grid_size.col then table_add(*antinodes, new_pos, the_void); } } part1 := antinodes.count; table_reset(*antinodes); for row: 0..grid_size.row-1 for col: 0..grid_size.col-1 { ptr := get(.{row, col}); chr := ptr.*; if chr == #char "." continue; for test_row: 0..grid_size.row-1 for test_col: 0..grid_size.col-1 if get(.{test_row, test_col}).* == chr && (row != test_row) && (col != test_col) { delta := Position.{row-test_row, col-test_col}; space := Position.{test_row, test_col}; while true { space.row += delta.row; space.col += delta.col; if space.row < 0 || space.row >= grid_size.row || space.col < 0 || space.col >= grid_size.col then break; if !table_find_pointer(*antinodes, space) then table_add(*antinodes, space, the_void); } space = Position.{test_row, test_col}; while true { // subtract delta space.row -= delta.row; space.col -= delta.col; if space.row < 0 || space.row >= grid_size.row || space.col < 0 || space.col >= grid_size.col then break; if !table_find_pointer(*antinodes, space) then table_add(*antinodes, space, the_void); } } } part2 := antinodes.count; return part1, part2; }

Good lord... Day 14 part 2 was unusual. It _was not_ fun trying to find an image without knowing its appearance, but the reward was definitely felt at the end. I initially thought that the image of a christmas tree appears when all points on the middle lines (horizontal and vertical) are occupied by robots, so I tried searching for such a configuration but that yielded on results. Today, I tried the visual approach: wrote thousands of grid images to a file and searched for many 'x' characters in a row (I represented robots with 'x'), which finally led me to the image of that christmas tree. haskell type Robot = (Position, Velocity) type Position = (Integer,Integer) type Velocity = (Integer,Integer) robotParser = do stringParser "p=" x <- integerParser charParser ',' y <- integerParser stringParser " v=" vx <- integerParser charParser ',' vy <- integerParser return ((x,y), (vx,vy)) inputParser = allParser robotParser parseInput = parseValue inputParser simulate :: (Integer,Integer) -> [Robot] -> [[Position]] simulate dims robs = map (\n -> map ((wrap dims) . fst . (move n)) robs) [0..] move :: Integer -> Robot -> Robot move n ((x,y), (vx,vy)) = ((x + (vx*n), y + (vy*n)), (vx,vy)) wrap :: (Integer,Integer) -> Position -> Position wrap (h,w) (x,y) = (x `mod` w, y `mod` h) quadrants (h,w) poss = groupingBy fst $ mapMaybe (\pos -> (,pos) <$> quadrant (h,w) pos) poss groupingBy :: (Ord b, Eq a) => (a -> b) -> [a] -> [[a]] groupingBy f = groupOn f . (sortOn f) quadrant (h,w) (x,y) = if x < (w `div` 2) && y < (h `div` 2) then Just "UL" else if x < (w `div` 2) && y > (h `div` 2) then Just "DL" else if x > (w `div` 2) && y > (h `div` 2) then Just "DR" else if x > (w `div` 2) && y < (h `div` 2) then Just "UR" else Nothing safetyFactor (h,w) n robs = product $ map length $ quadrants (h,w) $ (simulate (h,w) robs) !! n mkGrid (h,w) poss = accum (\_ x -> x) (listArray ((0,0), (w-1,h-1)) (repeat '.')) (map (,'x') poss) rows grid = sizedGroups (fromInteger w) (elems grid) where (_, (_,w)) = bounds grid draw :: (Integer,Integer) -> [Position] -> String draw dims poss = unlines . rows $ mkGrid dims poss -- 230172768 part1 = part1' <$> readInput 14 part1' s = product $ map length $ quadrants (103,101) $ (simulate (103,101) (parseInput s)) !! 100 -- 8084 part2 = readInput 14 >>= part2' part2' s = sequence_ $ map ((appendFile "/tmp/day14.out") . draw1) $ zipWith (,) [0..] sims where robs = parseInput s sims = simulate (103,101) robs draw1 (i,poss) = ("Step " ++ show i ++ ":\n") ++ (draw (103,101) poss) ++ "\n" >>40703 I have not looked at Idris in detail, only watched some tech talks on it (some by Edwin Brady). I understand that it offers powerful facilities for type-level computation, which interests me, so I may explore it in the future.

>>40706 nice consistency , are you also going to use prolog ?

everyone is doing Dijkstra's for today, but dfs is enough: import math import sys sys.setrecursionlimit(int(1e9)) g = list(map(list, open(0).read().split('\n'))); g.pop() rows, cols = len(g), len(g[0]) cache = [[math.inf] * cols for _ in range(rows)] m = {} def dfs(pos, d, cost): if pos == (1, cols - 2): return cost (r, c) = pos cache[r][c] = min(cache[r][c], cost) dx = ((-1, 0), (0, +1), (+1, 0), (0, -1)) minimum = math.inf # continue (dr, dc) = dx[d] (rr, cc) = (r + dr, c + dc) if g[rr][cc] in '.E' and cache[rr][cc] > cost - 1e3: minimum = min(minimum, dfs((rr, cc), d, cost + 1)) # turn left and continue (dr, dc) = dx[tmp := d-1 & 3] (rr, cc) = (r + dr, c + dc) if g[rr][cc] in '.E' and cache[rr][cc] > cost: minimum = min(minimum, dfs((rr, cc), tmp, cost + 1001)) # turn right and continue (dr, dc) = dx[tmp := d+1 & 3] (rr, cc) = (r + dr, c + dc) if g[rr][cc] in '.E' and cache[rr][cc] > cost: minimum = min(minimum, dfs((rr, cc), tmp, cost + 1001)) if minimum not in m: m[minimum] = set() m[minimum].add((r, c)) return minimum p2 = len(m[p1 := dfs((rows - 2, 1), 1, 0)]) + 1 print(p1, p2)

>>40709 Thanks anon, didn't want to do this one, but I hate being one day late... so I just converted yours =) ;; Translated from Anon https://lainchan.org/%CE%BB/res/40517.html#q40709 ;; because I'm tired and hate these path finding problems (in-package #:q3cpma-user) (load (make-pathname :defaults *load-truename* :name "../grid")) (defparameter *map* (grid-read *input-path* :type 'standard-char)) (defparameter *start* (grid-position #\S *map*)) (defparameter *end* (grid-position #\E *map*)) (defun turn-left (dir) (* dir #c(0 -1))) (defun turn-right (dir) (* dir #c(0 1))) (defparameter *cache* (make-hash-table)) (defparameter *mintiles* (make-hash-table)) (defun pathfind (pos dir cost) (if (= pos *end*) cost (macrolet ((lookup (pos) `(gethash ,pos *cache* most-positive-fixnum))) (minf (lookup pos) cost) (let ((min (apply #'min most-positive-fixnum ;; Dead-end => no available path (delete nil (mapcar #λ(and (char/= (grid-ref *map* pos _1) #\#) (> (lookup (+ pos _1)) (- (+ cost _2) 1000)) (pathfind (+ pos _1) _1 (+ 1 _2 cost))) `(,dir ,(turn-left dir) ,(turn-right dir)) '(0 1000 1000)))))) (setf (gethash pos (ensure-gethash min *mintiles* (make-hash-table))) t) min)))) (let ((mincost (pathfind *start* #c(0 1) #|East|# 0))) (format t "Part 1: ~A~%" mincost) (format t "Part 2: ~A~%" (+ (hash-table-count (gethash mincost *mintiles*)) 1))) You can use `read().rstrip()` instead of popping the last line and changing `in 'E.'` into `!= '#'` improves performance a little bit (250~500 ms here). Bonus, performance comparison: > lscpu | sed -n 's/ *Model name: *//p'; python -VV; sbcl --version AMD Ryzen 9 5900X 12-Core Processor Python 3.12.8 (main, Dec 13 2024, 13:16:08) [GCC 13.3.1 20241024] SBCL 2.4.11 > time python3 16/prog.py <16/input 102504 535 python3 16/prog.py < 16/input 5.96s user 0.75s system 99% cpu 6.733 total > time sbcl --load rc --script 16/prog.lisp 16/input Part 1: 102504 Part 2: 535 sbcl --noinform --load rc --script 16/prog.lisp 16/input 2.83s user 0.10s system 99% cpu 2.935 total

>>40714 >You can use `read().rstrip()` instead of popping the last line and changing `in 'E.'` into `!= '#'` improves performance a little bit cheers the biggest tank in performance is not having a separate cache graph for each direction; anything within ~1e3 cost is visited again, even if it really shouldn't. this is a naïve way of accounting for paths which arrive at the same cell from different directions

// input allocated 20000 bytes // output allocated 598080 bytes // output executed 15372.962 million cycles day9 :: (input: string) -> (part1: int, part2: int) { using Basic; files : [..]u8; array_reserve(*files, input.count/2); file_blocks, block_index := 0; for chr: cast([]u8) input { num := chr - #char "0"; if it_index % 2 == 0 { file_blocks += num; array_add(*files, num); } block_index += num; } number_of_blocks := block_index+1; part1, file_id, block_id := 0; for chr: cast([]u8) input { num := chr - #char "0"; if it_index % 2 == 0 { for 1..num { part1 += block_id * file_id; block_id += 1; if block_id >= file_blocks break chr; } file_id += 1; } else { for 1..num { file_id := files.count-1; part1 += block_id * file_id; block_id += 1; files[file_id] -= 1; if !files[file_id] then files.count -= 1; if !files break chr; if block_id >= file_blocks break chr; } } } reset_temporary_storage(); // don't need the part1 array anymore Span_Data :: struct { type : enum u16 { FILE; SPACE; }; file_id : s16; start : s16; width : s16; } Span :: struct { using data: Span_Data; next, prev: *Span; } append :: (old_end: *Span, data: Span_Data) -> (new_end: *Span) { new := New(Span); if old_end then old_end.next = new; new.data = data; new.prev = old_end; new.next = null; return new; } move :: (span: *Span, next: *Span) { new_span := New(Span); new_span.data = span.data; span.type = .SPACE; new_span.next = next; new_span.prev = next.prev; next.prev.next = new_span; next.prev = new_span; } last_span, first_span: *Span; file_id = 0; block_id = 0; for chr: cast([]u8) input { num := chr - #char "0"; if it_index % 2 == 0 { last_span = append(last_span, .{.FILE, xx file_id, xx block_id, num}); file_id += 1; } else { last_span = append(last_span, .{.SPACE, xx (file_id-1), xx block_id, num}); } if !first_span first_span = last_span; block_id += num; } file_to_move := last_span; while main_loop := file_to_move { defer file_to_move = file_to_move.prev; if file_to_move.type != .FILE then continue; gap_to_fill := first_span; while true { if !gap_to_fill break; if gap_to_fill == file_to_move then continue main_loop; defer gap_to_fill = gap_to_fill.next; if gap_to_fill.type != .SPACE || gap_to_fill.width < file_to_move.width then continue; gap_to_fill.start += file_to_move.width; gap_to_fill.width -= file_to_move.width; if file_to_move == last_span then last_span = last_span.prev; if file_to_move == first_span then first_span = first_span.next; move(file_to_move, gap_to_fill); gap_to_fill = first_span; file_to_move = last_span; assert(xx gap_to_fill); assert(xx file_to_move); continue main_loop; } } part2 := 0; block_id = 0; span := first_span; while span { defer span = span.next; if span.type == .FILE for 1..span.width { part2 += block_id * span.file_id; block_id += 1; } else { block_id += span.width; } } return part1, part2; } // input allocated 2070 bytes // output allocated 384 bytes // output executed 1.010 million cycles day10 :: (input: string) -> (part1: int, part2: int) { using Basic; using Hash_Table; Position :: struct { row, col: s32; } grid_size: Position; rhs := input; while true { ok:, line:, rhs = split_line(rhs); if !ok break; assert(xx line); grid_size.col = xx line.count; grid_size.row += 1; } Cache :: Table(Position, void, hash_bytes, comp_bytes); walk :: (using start: Position, expected: u8, grid_data: string, grid_size: Position, trail_ends: *Cache) -> int { if row < 0 || row >= grid_size.row || col < 0 || col >= grid_size.col then return 0; chr := grid_data[row*(grid_size.col+1) + col]; // grid_size.col+1 to account for newlines in input if chr != expected return 0; if chr == #char "9" { if !trail_ends return 1; if table_find_pointer(trail_ends, start) return 0; table_add(trail_ends, start, the_void); return 1; } acc := 0; for Position.[ .{row-1, col}, // up .{row+1, col}, // down .{row, col-1}, // left .{row, col+1} // right ] acc += walk(it, expected + 1, grid_data, grid_size, trail_ends); return acc; } trail_ends: Cache; part1, part2 := 0; for row: 0..grid_size.row-1 for col: 0..grid_size.col-1 { start, zero := Position.{row, col}, cast(u8) #char "0"; table_reset(*trail_ends); part1 += walk(start, zero, input, grid_size, *trail_ends); part2 += walk(start, zero, input, grid_size, null); } return part1, part2; }

Completed day 15 after too much trial and error in part 2. Had to rewrite the whole thing today. Also, misunderstood how to calculate GPS for part 2: I was measuring distances to the _closest edge_ of the box. And that's exactly how it's described in the task! But what is actually meant is: distance from the top and left edges of the map to the left edge of a box... Well, I'm just glad it's over now. haskell data Dir = L | R | U | D deriving Show data Tile = Box | Wall | Robot | Floor | LBox | RBox deriving (Eq,Show) type Pos = (Int,Int) type Grid = Array Pos Tile simulate :: Grid -> Pos -> [Dir] -> (Grid, Pos) simulate grid pos dirs = foldl' h (grid,pos) dirs where h (grid',pos') dir = simulate1 grid' pos' dir simulate1 :: Grid -> Pos -> Dir -> (Grid, Pos) simulate1 grid pos dir = case (grid ! nextPos) of Wall -> (grid, pos) Floor -> (grid, nextPos) tile | isBox tile -> case shiftBox grid nextPos dir of Nothing -> (grid, pos) Just grid' -> (grid', nextPos) where nextPos = move dir pos shiftBox :: Grid -> Pos -> Dir -> Maybe Grid shiftBox grid pos dir = if any ((== Wall) . snd) adjTiles then Nothing else if all ((== Floor) . snd) adjTiles then Just (moveBox grid pos dir) else if any (isBox . snd) adjTiles then maybeFoldl' (\g p -> shiftBox g p dir) grid ((map fst (filter (isBox . snd) adjTiles)) ++ [pos]) else undefined where adjTiles = map (\p -> (p, grid ! p)) adjPoss adjPoss = case (grid ! pos, dir) of (Box,_) -> [move dir pos] (LBox, R) -> [move dir (move dir pos)] (RBox, L) -> [move dir (move dir pos)] (RBox, U) -> uniqBoxes grid (move L (move dir pos), move dir pos) (RBox, D) -> uniqBoxes grid (move L (move dir pos), move dir pos) (LBox, U) -> uniqBoxes grid (move dir pos, move R (move dir pos)) (LBox, D) -> uniqBoxes grid (move dir pos, move R (move dir pos)) (x,_) -> error ("not a box: " ++ (show x)) moveBox grid pos dir = case (grid ! pos) of Box -> grid // [(pos, Floor), (move dir pos, Box)] LBox -> let rpos = (move R pos) in grid // [(pos, Floor), (rpos, Floor), (move dir pos, LBox), (move dir rpos, RBox)] RBox -> let lpos = (move L pos) in grid // [(pos, Floor), (lpos, Floor), (move dir lpos, LBox), (move dir pos, RBox)] _ -> error "not a box" uniqBoxes grid (pos1,pos2) = case (grid ! pos1, grid ! pos2) of (LBox,RBox) -> [pos1] _ -> [pos1, pos2] isBox Box = True isBox LBox = True isBox RBox = True isBox _ = False maybeFoldl' f z xs = foldl' h (Just z) xs where h Nothing _ = Nothing h (Just z') x = f z' x move U (r,c) = (r-1,c) move D (r,c) = (r+1,c) move R (r,c) = (r,c+1) move L (r,c) = (r,c-1) gps :: Grid -> Pos -> Int gps grid pos@(r,c) = case grid ! pos of Box -> (100 * (r-1)) + (c-1) LBox -> (100 * (r-1)) + (c-1) mkGrid :: [[Tile]] -> (Grid, Pos) mkGrid tiles = (grid // [(robotPos, Floor)], robotPos) where grid = listArray ((1,1), (h,w)) (concatMap id tiles) robotPos = fst . fromJust $ find ((== Robot) . snd) (assocs grid) h = length tiles w = length (head tiles) showGrid :: Grid -> String showGrid grid = unlines $ map (map tileChar) rows where rows = sizedGroups w (elems grid) (_,(_,w)) = bounds grid tileChar tile = case tile of Box -> 'O' LBox -> '[' RBox -> ']' Floor -> '.' Wall -> '#' inputParser :: Parser (Grid, Pos, [Dir]) inputParser = do rows <- (filter (not . null)) <$> separatedByParser (charParser '\n') (listParser tileParser) (grid, robot) <- return (mkGrid rows) moves <- allParser moveParser return (grid, robot, moves) tileParser = oneOfParser (zipWith (\c d -> (const d) <$> charParser c) "#.O@" [Wall,Floor,Box,Robot]) moveParser = oneOfParser (zipWith (\c d -> (const d) <$> charParser c) "^><v" [U,R,L,D]) resize (grid, (r,c)) = (grid', (r, c*2 - 1)) where grid' = listArray ((1,1), (h,w*2)) (concatMap replaceTile (elems grid)) ((_,_), (h,w)) = bounds grid replaceTile tile = case tile of Box -> [LBox, RBox] _ -> [tile, tile] -- 1527563 part1 = part1' <$> readInput 15 part1' s = sum $ map ((gps grid') . fst) boxes where (grid,pos,dirs) = parseValue inputParser s (grid',_) = simulate grid pos dirs boxes = filter ((== Box) . snd) (assocs grid') -- 1521635 part2 = part2' <$> readInput 15 part2' s = sum $ map ((gps grid'') . fst) boxes where (grid,pos,dirs) = parseValue inputParser s (grid',pos') = resize (grid,pos) (grid'',_) = simulate grid' pos' dirs boxes = filter ((== LBox) . snd) (assocs grid'') >>40707 I can't tell if this is a real question. But no -- I am not going to use Prolog.

Failed today's part 2, as it's one of those "unless you get the Eureka, go fuarrrk yourself" gifts. If tomorrow is as soykafty, that's the end for me, lainons. But I had fun exploiting CL's party trick runtime compilation to go brrrr! (in-package #:q3cpma-user) (defparameter *RA* 0) (defparameter *prog* nil) (let* ((input (uiop:read-file-string *input-path*)) (ints (mapcar #'parse-integer (cl-ppcre:all-matches-as-strings "\\d+" input)))) (setf *RA* (nth 0 ints) *prog* (subseq ints 3))) (defun %translate-prog (is-quine-p) (assert (equal (last *prog* 2) '(3 0))) ;; *prog* always loops to the beginning! `(lambda (RA &aux (RB 0) (RC 0)) (declare (optimize (speed 3) (debug 0) (safety 0))) (declare (type (integer 0) RA RB RC)) (iter ,@(if is-quine-p `((with ref = (list ,@*prog*)))) (while (/= 0 RA)) ,@(flet ((combo (n) (case n ((0 1 2 3) n) (4 'RA) (5 'RB) (6 'RC)))) (iter (for (ins op) on (butlast *prog* 2) by #'cddr) (collect (case ins (0 `(setf RA (truncate RA (expt 2 ,(combo op))))) (1 `(setf RB (logxor RB ,op))) (2 `(setf RB (logand ,(combo op) #b111))) (3 (error "Loop inside!")) (4 `(setf RB (logxor RB RC))) (5 (if is-quine-p ;; Stop at the first output difference `(while (eql (pop ref) (logand ,(combo op) #b111))) `(collect (logand ,(combo op) #b111)))) (6 `(setf RB (truncate RA (expt 2 ,(combo op))))) (7 `(setf RC (truncate RA (expt 2 ,(combo op))))))))) ,@(if is-quine-p `((finally (return (null ref)))))))) (defun find-good-RA () (iter (with compiled = (compile-prog :is-quine-p t)) (with len = (length *prog*)) (for RA from (expt 2 (* 3 (- len 1)))) ;; Observation: 2^3(x-1) < RA < 2^(3x-1) => output len x (finding RA such-that (funcall compiled RA)))) (defun compile-prog (&key is-quine-p) (let ((tr (%translate-prog is-quine-p))) (format t "Input: ~A~%Output: ~S~%" *prog* tr) (compile nil tr))) (format t "Part 1: ~{~A~^,~}~%" (funcall (compile-prog) *RA*)) (format t "Part 2: ~A~%" (find-good-RA)) $ sbcl --load rc --script 17/prog.lisp 17/sample2 Input: (0 3 5 4 3 0) Output: (LAMBDA (RA &AUX (RB 0) (RC 0)) (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0))) (DECLARE (TYPE (INTEGER 0) RA RB RC)) (ITER (WHILE (/= 0 RA)) (SETF RA (TRUNCATE RA (EXPT 2 3))) (COLLECT (LOGAND RA 7)))) Part 1: 5,7,3,0 Input: (0 3 5 4 3 0) Output: (LAMBDA (RA &AUX (RB 0) (RC 0)) (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0))) (DECLARE (TYPE (INTEGER 0) RA RB RC)) (ITER (WITH REF = (LIST 0 3 5 4 3 0)) (WHILE (/= 0 RA)) (SETF RA (TRUNCATE RA (EXPT 2 3))) (WHILE (EQL (POP REF) (LOGAND RA 7))) (FINALLY (RETURN (NULL REF))))) Part 2: 117440 >>40726 I can feel your pain, mate. Still pretty even if there's much repetition. That shiftBox code makes me truly appreciate how pretty (cond) is compared to the usual if-else-if.

>>40728 i really enjoyed part 2 today; it's one of those "keep making observations until the solution reveals itself" days definitely a day for pen and paper though

really gave up with day 12... // input allocated 36 bytes // output allocated 16776192 bytes // output executed 99.383 million cycles day11 :: (input: string) -> (part1: int, part2: int) { using Basic; using String; using Math; using Hash_Table; Cache :: Table(U128, int, hash_bytes, comp_bytes); blink_at :: (stone: int, max_depth: int, cache: *Cache, depth := 0) -> int { p := table_find_pointer(cache, .{xx stone, xx (max_depth-depth)}); if p return p.*; if stone == 0 { if depth == max_depth return 1; x := blink_at(1, max_depth, cache, depth+1); table_add(cache, .{xx stone, xx (max_depth-depth)}, x); return x; } digits := count_digits(stone); if digits % 2 == 0 { if depth == max_depth return 2; mask := cast(int) pow(10, xx (digits / 2)); left := stone / mask; right := stone % mask; x := blink_at(left, max_depth, cache, depth+1) + blink_at(right, max_depth, cache, depth+1); table_add(cache, .{xx stone, xx (max_depth-depth)}, x); return x; } if depth == max_depth return 1; x := blink_at(stone*2024, max_depth, cache, depth+1); table_add(cache, .{xx stone, xx (max_depth-depth)}, x); return x; } cache: Cache; part1, part2 := 0; rhs := input; while true { ok:, stone_str:, rhs = split_from_left(rhs, #char " "); if !ok && !stone_str break; stone:, ok = string_to_int(stone_str); part1 += blink_at(stone, 24, *cache); part2 += blink_at(stone, 74, *cache); } return part1, part2; } // input allocated 19740 bytes // output allocated 786048 bytes // output executed 9.238 million cycles day12 :: (input: string) -> (part1: int, part2: int) { using Basic; using Hash_Table; Position :: struct { row, col: s32; } grid_size: Position; rhs := input; while true { ok:, line:, rhs = split_line(rhs); if !ok break; assert(xx line); grid_size.col = xx line.count; grid_size.row += 1; } Direction :: enum_flags { UP; DOWN; LEFT; RIGHT; }; Cache :: Table(Position, void, hash_bytes, comp_bytes); fill :: (using pos: Position, cache: *Cache, input: string, grid_size: Position) -> int, int, int { if table_find_pointer(cache, pos) return 0, 0, 0; // already counted table_add(cache, pos, the_void); get :: (p: Position) -> u8 #expand { return input[p.row * (grid_size.row+1) + p.col]; } val := get(pos); area := 0; outer := 0; inner := 0; dirs: Direction; for struct { dir: Direction; using pos: Position; }.[ .{.UP, .{row-1, col}}, .{.DOWN, .{row+1, col}}, .{.LEFT, .{row, col-1}}, .{.RIGHT, .{row, col+1}} ] { if it.row < 0 || it.row >= grid_size.row || it.col < 0 || it.col >= grid_size.col { area += 1; dirs |= it.dir; continue; } neighbor := get(it.pos); if neighbor == val { a, b, c := fill(it.pos, cache, input, grid_size); area += a; outer += b; inner += c; } else { area += 1; dirs |= it.dir; l_col := it.col - 1; r_col := it.col + 1; u_row := it.row - 1; d_row := it.row + 1; if it.dir & .UP { if l_col >= 0 && l_col < grid_size.col && get(.{it.row, l_col}) == val && d_row >= 0 && d_row < grid_size.row && get(.{d_row, l_col}) == val then inner += 1; if r_col >= 0 && r_col < grid_size.col && get(.{it.row, r_col}) == val && d_row >= 0 && d_row < grid_size.row && get(.{d_row, r_col}) == val then inner += 1; } else if it.dir & .DOWN { if l_col >= 0 && l_col < grid_size.col && get(.{it.row, l_col}) == val && u_row >= 0 && u_row < grid_size.row && get(.{u_row, l_col}) == val then inner += 1; if r_col >= 0 && r_col < grid_size.col && get(.{it.row, r_col}) == val && u_row >= 0 && u_row < grid_size.row && get(.{u_row, r_col}) == val then inner += 1; } else if it.dir & .LEFT { if u_row >= 0 && u_row < grid_size.col && get(.{u_row, it.col}) == val && r_col >= 0 && r_col < grid_size.row && get(.{u_row, r_col}) == val then inner += 1; if d_row >= 0 && d_row < grid_size.col && get(.{d_row, it.col}) == val && r_col >= 0 && r_col < grid_size.row && get(.{d_row, r_col}) == val then inner += 1; } else if it.dir & .RIGHT { if u_row >= 0 && u_row < grid_size.col && get(.{u_row, it.col}) == val && l_col >= 0 && l_col < grid_size.row && get(.{u_row, l_col}) == val then inner += 1; if d_row >= 0 && d_row < grid_size.col && get(.{d_row, it.col}) == val && l_col >= 0 && l_col < grid_size.row && get(.{d_row, l_col}) == val then inner += 1; } } } if (dirs & .UP) && (dirs & .LEFT) outer += 1; if (dirs & .UP) && (dirs & .RIGHT) outer += 1; if (dirs & .DOWN) && (dirs & .LEFT) outer += 1; if (dirs & .DOWN) && (dirs & .RIGHT) outer += 1; return area, outer, inner; } cache: Cache; to_test: Position; part1, part2 := 0; while true { defer { to_test.col += 1; if to_test.col == grid_size.col { to_test.col = 0; to_test.row += 1; if to_test.row == grid_size.row break; } } if table_find_pointer(*cache, to_test) continue; count := cache.count; fence_count, outer, inner := fill(to_test, *cache, input, grid_size); area_count := (cache.count-count); part1 += area_count * fence_count; part2 += area_count * (outer + ((inner+1)/2)); } return part1, part2; }

I'm stuck on Day 16. Tried naive DFS, too slow. DFS with caching (store paths from each position to the maze's exit), still too slow for real input, and also incorrect, as part 2 revealed. Tried something similar to Dijkstra's algorithm, solved part 1, but don't see how to apply it to part 2. Damn mazes... Can't be losing sleep anymore, so I'll be catching up on the weekend.

very simple dynamic programming problem today; Eric has gone soft patterns, designs = open(0).read().strip().split('\n\n') patterns = set(patterns.split(', ')) p1 = p2 = 0 for design in designs.split('\n'): n = len(design) dp = [1] + [0]*n for i in range(n): for pattern in patterns: m = len(pattern) if design[i:i+m] == pattern: dp[i+m] += dp[i] p1 += bool(dp[-1]) p2 += dp[-1] print(p1, p2) >>40748 if you want spoilers, i solved it using dfs here: >>40709 you have to be careful with your cache as branches can reach the same cell from different directions; a branch with a higher cost may beat a branch with a lower cost if it has to turn Dijkstra's is the "correct" solution, i recommend reading: https://cp-algorithms.com/graph/dijkstra.html all other resources (e.g. wikipedia, computerphile, etc.) are garbage

>>40751 space-optimised patterns, designs = open(0).read().strip().split('\n\n') patterns = set(patterns.split(', ')) p1 = p2 = 0 for design in designs.split('\n'): n = len(design) dp = [1] + [0]*max(map(len, patterns)) k = len(dp) for i in range(n): dp[(i - 1) % k] = 0 if not dp[i % k]: # nothing to push if not any(dp): # no solution break continue for pattern in patterns: m = len(pattern) if design[i:i+m] == pattern: dp[(i + m) % k] += dp[i % k] p1 += bool(dp[n % k]) p2 += dp[n % k] print(p1, p2)

simply not enough hours in the day to keep doing these after a certain point. I lucked out with day 13 being very easy, but the rest will have to wait until the weekend. // input allocated 20991 bytes // output allocated 0 bytes // output executed 0.227 million cycles day13 :: (input: string) -> (part1: int, part2: int) { using Basic; rhs := input; part1, part2 := 0; while true { parse_line :: (name: string) -> (x: int, y: int) #expand { ok:, line:, rhs = split_line(rhs); assert(ok); advance(*line, name.count); x:, ok, line = string_to_int(line); assert(ok); advance(*line, ", Y+".count); y:, ok, line = string_to_int(line); assert(ok); return x, y; } xa, ya := parse_line("Button A: X+"); xb, yb := parse_line("Button B: X+"); xp, yp := parse_line("Prize: X="); det := (xa*yb) - (xb*ya); if det { a := (+yb*xp) + (-xb*yp); b := (-ya*xp) + (+xa*yp); if !(a % det) && !(b % det) then part1 += ((a/det)*3) + (b/det); xp += 10000000000000; yp += 10000000000000; a = (+yb*xp) + (-xb*yp); b = (-ya*xp) + (+xa*yp); if !(a % det) && !(b % det) then part2 += ((a/det)*3) + (b/det); } ok:, _, rhs = split_line(rhs); if !ok break; } return part1, part2; }

slooow but simple day 20; just bfs for distances without cheats, then try all jumps of manhattan distance <= 20 there are some fairly obvious optimisations, but i'm happy with the aesthetics of my solution g = list(map(list, open(0).read().strip().split('\n'))) rows = len(g); cols = len(g[0]) dx = ((-1, 0), (0, +1), (+1, 0), (0, -1)) out = lambda r, c : not 0 <= r < rows and 0 <= c < cols pos = lambda ch : [(r, c) for r, x in enumerate(g) for c, y in enumerate(x) if y == ch][0] visited = [[False] * cols for _ in range(rows)] picosec = [[ -1 ] * cols for _ in range(rows)] (r, c) = pos('S') visited[r][c] = True picosec[r][c] = 0 q = [(r, c)] while q: (r, c) = q.pop(0) for dr, dc in dx: (rr, cc) = (r + dr, c + dc) if out(rr, cc) or visited[rr][cc] or g[rr][cc] == '#': continue visited[rr][cc] = True picosec[rr][cc] = picosec[r][c] + 1 q.append((rr, cc)) p1 = p2 = 0 for rr in range(rows): for cc in range(cols): for r in range(rows): for c in range(cols): if (not visited[r][c] or (manhattan := abs(rr - r) + abs(cc - c)) > 20): continue if picosec[rr][cc] - manhattan - picosec[r][c] >= 100: p1 += manhattan == 2 p2 += 1 print(p1, p2) Days : 0 Hours : 0 Minutes : 1 Seconds : 10 Milliseconds : 686 Ticks : 706860700 TotalDays : 0.000818125810185185 TotalHours : 0.0196350194444444 TotalMinutes : 1.17810116666667 TotalSeconds : 70.68607 TotalMilliseconds : 70686.07

>>40748 I did it. Finally solved part 2 of day 16 using some nth variation of Dijkstra's algorithm and arduously retracing the best paths. I must admit it took me more than 100 lines of Haskell ... and it runs in reasonable time only when compiled with the optimise flag :) One more search problem and I swear... >>40709 I'm having a hard time understanding your solution. I can see that the general strategy is: for a given position, explore adjacent ones only if their cached cost is greater than some value computed from the current cost. This last part gets me confused. Specifically, the right-hand sides in comparisons with cache[rr][cc]. Why is it (cost - 1e3) for a move in the same direction? Why not (cost + 1)? And for moves that change direction -- why is it (cost) and not (cost + 1001) ?

>>40777 Not him, but since I translated his program: from my understanding, the cache is here to detect loops and abort early. The assumption is that if you already visited this tile in the other direction, the actual correct path is either to the left or to the right (cache + 1000).

>>40778 Aha! This makes sense. Thank you. I don't think I could have come up with that.

Here is my Day 17. I implemented a very specific solution for part 2 that only works for my kind of input. Generalising it is an interesting problem, where logic programming could be applied, so maybe I will use Prolog after all ;) haskell nth n xs = maybeHead (drop n xs) data Computer = Computer { regA :: Int, regB :: Int, regC :: Int, ip :: Int, output :: [Int] } deriving Show type Instr = (Opcode,Operand) type Operand = Int data Opcode = Adv | Bxl | Bst | Jnz | Bxc | Out | Bdv | Cdv deriving (Show,Eq) opcodes = [Adv, Bxl, Bst, Jnz, Bxc, Out, Bdv, Cdv] opcode x = opcodes !! x instruction op rand = (opcode op, rand) step comp = comp { ip = (ip comp) + 2 } out x comp = comp { output = (output comp) ++ [x] } run :: Computer -> [Instr] -> Computer run comp inss = case nextIns of Nothing -> comp Just ins -> run (eval comp ins) inss where nextIns | (ip comp) `mod` 2 /= 0 = error "Instruction pointer is odd!" | otherwise = nth (ip comp `div` 2) inss eval comp (opcode, rand) = case opcode of Adv -> step $ comp { regA = (regA comp) `div` (2 ^ comboVal) } Bxl -> step $ comp { regB = (regB comp) `xor` rand } Bst -> step $ comp { regB = comboVal `mod` 8 } Jnz -> if (regA comp) == 0 then step comp else comp { ip = rand } Bxc -> step $ comp { regB = (regB comp) `xor` (regC comp) } Out -> step $ out (comboVal `mod` 8) comp Bdv -> step $ comp { regB = (regA comp) `div` (2 ^ comboVal) } Cdv -> step $ comp { regC = (regA comp) `div` (2 ^ comboVal) } where comboVal = combo comp rand combo comp rand = xs !! rand where xs = [0,1,2,3,regA comp,regB comp,regC comp] inputParser = do nums <- allParser $ fromInteger <$> integerParser let ((regA : regB : regC : []), prog) = splitAt 3 nums in return (Computer regA regB regC 0 [], map (uncurry instruction) (pairs prog)) pairs (a : b : xs) = (a,b) : pairs xs pairs _ = [] parseInput = parseValue inputParser part1 = part1' <$> readInput 17 part1' s = output (run comp inss) where (comp, inss) = parseInput s -- Part 2 -- The solution is specialised for a specific input, which has the following properties: -- * There is a single jump instruction, it is the last one and jumps to 0. -- * At each iteration A = A / 8, and other registers can be computed from A alone. -- * At the last iteration A = 0 (true for any input). -- To solve the thing we find possible values of A for each iteration, starting from the last one. -- For each iteration, given the value of A at the end of the iteration and the expected output symbol, -- find all values that A could have at the beginning of the iteration. part2 = part2' <$> readInput 17 part2' s = minimum $ foldr h [0] (concatMap unparseInstr inss) where (comp, inss) = parseInput s h eo eas = map regA $ concatMap (\ea -> revStep comp inss ea eo) eas revStep :: Computer -> [Instr] -> Int -> Int -> [Computer] revStep comp inss ea eo = filter good $ map (\a -> comp {regA = a}) as where as = range (max (ea * 8) 1, (ea * 8) + 7) good comp = (regA comp') == ea && (output comp') == [eo] where comp' = run1 comp inss -- Run all instructions sequentially. -- Since jump is the last one and jumps to 0, it has no effect. run1 comp inss = foldl' eval comp inss unparseInstr (opcode,rand) = [fromJust $ elemIndex opcode opcodes, rand]

And here goes Day 18. It's a search problem, but much more friendlier than the nightmare of Day 16. haskell type Grid = Array Pos Char type Pos = (Int,Int) adjacent (r,c) = [ (r-1,c), (r+1,c), (r,c-1), (r,c+1) ] -- Builds a map of distances from `start` analyse :: Grid -> Pos -> Pos -> M.Map Pos Int analyse grid start end = analyse' grid start end (M.singleton start 0) analyse' grid pos dst dists | pos == dst = dists | otherwise = foldl' h dists adjs where adjs = filter (maybe False (== '.') . (grid `at`)) $ adjacent pos posDist = dists M.! pos adjDist = 1 + posDist h dists' adj = maybe (analyse' grid adj dst dists'') (const dists'') (filterMaybe (<= adjDist) oldAdjDist) where (oldAdjDist, dists'') = insertLookupWith min adj adjDist dists' shortestPath grid start end = dists M.! end where dists = analyse grid start end inputParser :: Parser [Pos] inputParser = pairs <$> allParser (fromInteger <$> integerParser) where pairs xs = map (\[a,b] -> translatePos (a,b)) $ sizedGroups 2 xs translatePos (x,y) = (r,c) where (r,c) = (y,x) mkGrid (h,w) bytePoss = accum (flip const) (listArray ((0,0), (h,w)) (repeat '.')) (map (,'#') bytePoss) part1' s = shortestPath grid (0,0) (70,70) where grid = mkGrid (70,70) (take 1024 (parseValue inputParser s)) -- Part 2 part2' s = firstBadByte (0,0) (70,70) 1024 (70,70) bytePoss where bytePoss = parseValue inputParser s hasPath grid start end = M.member end dists where dists = analyse grid start end firstBadByte start end offset dims bytePoss = badByte where badByte = snd $ fromJust $ binSearch (\(grid,_) -> hasPath grid start end) xs xs = map (\bs -> (mkGrid dims bs, last bs)) (drop (offset + 1) (inits bytePoss)) binSearch :: (a -> Bool) -> [a] -> Maybe a binSearch pred [] = Nothing binSearch pred xs = if pred c then binSearch pred r else (binSearch pred l) <|> (Just c) where (l, c, r) = binSplit xs binSplit [] = error "empty" binSplit [x] = ([], x, []) binSplit xs = (l, c, r) where (l, (c:r)) = splitAt (length xs `div` 2) xs

>>40751 Impressive. How did you come up with such a concise solution? I had to think hard to understand it. Mine is not so elegant. Makes Haskell look bad :) haskell type Pattern = String type Design = String possibles patts designs = filter (possible (S.fromList patts)) designs possible patts [] = True possible patts design = S.member design patts || isJust (find match $ splits design) where match (l,r) = (S.member l patts) && (possible patts r) combo :: Design -> S.Set Pattern -> M.Map Pattern Int -> (M.Map Pattern Int, Int) combo [] _ _ = undefined combo d@[_] patts cache = swap $ insertLookup d v cache where v = if S.member d patts then 1 else 0 combo design patts cache = case M.lookup design cache of Just n -> (cache,n) Nothing -> (M.insert design v cache', v) where v = (if S.member design patts then 1 else 0) + (sum ns) (cache',ns) = mapAccumL h cache (splits design) h c (l,r) = if S.member l patts then combo r patts c else (c,0) combos patts designs = mapAccumL h M.empty designs where h cache d = combo d (S.fromList patts) cache insertLookup k a m = case M.insertLookupWithKey (\_ _ old -> old) k a m of (Nothing, m') -> (a, m') (Just o, m') -> (o, m') swap (a,b) = (b,a) splits xs = if len <= 1 then [] else map (\i -> splitAt i xs) [1..(len - 1)] where len = length xs inputParser :: Parser ([Pattern], [Design]) inputParser = do patts <- separatedByParser (stringParser ", ") wordParser designs <- allParser wordParser return (patts, designs) parseInput = parseValue inputParser wordParser = test (not . null) $ listParser (test isLetter anyCharParser) part1' s = length $ possibles patts designs where (patts, designs) = parseInput s part2' s = sum $ snd $ combos patts designs where (patts, designs) = parseInput s

unwashed day 21 part 2: https://0x0.st/8rxU.py unwashed day 24 part 2: https://0x0.st/8rxf.py >>40777 >why is it (cost) and not (cost + 1001) ? sorry, it was golfed from something intuitive to derive to something... shorter but not intuitive >>40791 >How did you come up with such a concise solution? I had to think hard to understand it i've seen similar patterns before, so i didn't have to think about it at all actually once you've found the state variables, recurrence relations, and base cases, it "just works" for harder dp problems the trick is to think in terms of "which states can reach me?" (pull dp), or "which states can i reach?" (push dp) then your recurrence relations are just some operation on those states

>>40802 slightly washed day 24 part 2 import math inputs, gates = open(0).read().strip().split('\n\n') inputs = inputs.split('\n') gates = gates.split('\n') candidates = [] togates = {} # maps wire <-> ops for gate in gates: a, op, b, _, c = gate.split() if a not in togates: togates[a] = [] if b not in togates: togates[b] = [] togates[a].append(op) togates[b].append(op) axorb = set() for gate in gates: a, op, b, _, c = gate.split() if c[0] == 'z' and c in togates: candidates.append(c) if a[0] in 'xy' or b[0] in 'xy': if c in ('z00', 'kqn'): # skip half adder continue if op == 'XOR': axorb.add(c) if c not in togates or sorted(togates[c]) != ['AND', 'XOR']: candidates.append(c) if op == 'AND': if c not in togates or sorted(togates[c]) != ['OR']: candidates.append(c) if op == 'OR': if c in ('z45'): # skip last carry continue if c not in togates or sorted(togates[c]) != ['AND', 'XOR']: candidates.append(c) for gate in gates: a, op, b, _, c = gate.split() if op == 'XOR' and c not in axorb and c in togates: candidates.append(c) if op == 'AND' and a[0] not in 'xy': if c not in togates or sorted(togates[c]) != ['OR']: candidates.append(c) print(','.join(sorted(candidates)))

Day 22. I was intimidated by part 2 at first, but then found a simple solution. It's nice to construct maps from association lists. [code] haskell mix :: Int -> Int -> Int mix = xor prune :: Int -> Int prune = (`mod` 16777216) step :: Int -> Int step n = n3 where n1 = prune $ (n * 64) `mix` n n2 = prune $ (n1 `div` 32) `mix` n1 n3 = prune $ (n2 * 2048) `mix` n2 nthSecret n seed = (iterate step seed) !! n inputParser :: Parser [Int] inputParser = allParser (fromInteger <$> integerParser) part1' s = sum $ map (nthSecret 2000) ns where ns = parseValue inputParser s -- Part 2 part2' s = maximumOn snd $ M.assocs priceMap where ns = parseValue inputParser s series = map (take 2000 . iterate step) ns priceMap = M.unionsWith (+) $ map priceMapFrom series priceMapFrom :: [Int] -> M.Map [Int] Int priceMapFrom ns = M.fromListWith (\_ old -> old) $ map mkAssoc $ windows 4 pairs where pairs = zip (drop 1 prices) changes mkAssoc win = (map snd win, fst $ last win) prices = map (`mod` 10) ns changes = zipWith (-) (drop 1 prices) prices windows n xs = filter ((== n) . length) $ map (take n) $ tails xs [\code]

Day 23. Easy part 1, but resorted to cheating for part 2 by visiting https://en.wikipedia.org/wiki/Clique_problem I wonder why code formatting didn't work for my Day 22 post. type Computer = String inputParser :: Parser [(Computer, Computer)] inputParser = pairs <$> allParser computerParser where pairs xs = map (\[a,b] -> (a,b)) $ sizedGroups 2 xs computerParser = test (not . null) $ listParser (test isLetter anyCharParser) part1' s = S.filter (any3 ((== 't') . head)) $ computerTriples computerPairs where computerPairs = parseValue inputParser s any3 pred (a,b,c) = pred a || pred b || pred c sort3 (a,b,c) = (a',b',c') where [a',b',c'] = sort [a,b,c] computerTriples conns = S.fromList $ map sort3 $ filter connected triples where connMap = M.fromListWith (++) $ map (\(a,b) -> (a, [b])) $ concatMap (\(a,b) -> [(a,b), (b,a)]) conns triples = concatMap triples' $ M.assocs connMap triples' (a, bs) = map (\(b,c) -> (a,b,c)) $ pairs bs connected (a,b,c) = isJust $ filterMaybe (elem c) $ M.lookup b connMap pairs :: [a] -> [(a,a)] pairs xs = concat $ zipWith (\x xs' -> map (x,) xs') xs (drop 1 (tails xs)) -- Part 2 part2' s = sort $ S.toList $ maxClique connMap where conns = parseValue inputParser s connMap = M.fromListWith (++) $ map (\(a,b) -> (a, [b])) $ concatMap (\(a,b) -> [(a,b), (b,a)]) conns maxClique graph = maximumOn S.size $ cliques graph cliques :: M.Map Computer [Computer] -> [S.Set Computer] cliques graph = map (clique graph) (M.assocs graph) clique graph (a, bs) = foldl' add (S.singleton a) bs where add clq b = if all (connected b) (S.toList clq) then S.insert b clq else clq connected x y = isJust $ filterMaybe (elem y) $ M.lookup x graph

>>40817 thanks for the link, i brootforced day 23 to be honest your code didn't embed because you typed \code not /code

>>40821 Aha... Haskell got me in the habit of typing backslash frequently (for lambda parameters) and I couldn't tell it apart from the regular slash :)