Obvs couldn't do this in 2024, cleaning up the README

Forgot to push these all onto the cloud lol

2015/README.txt

@@ -4,26 +4,16 @@
                           ___________________
 
 
-From 01/11/2024 to 30/11/2024 I will be attempting to finish 2015's
-advent of code in preparation for 2024's AOC.
+I want to do this advent of code in more than one language if
+possible.  Here is a list of all the languages I am aware of enough to
+program in, ordered from least to most confidence:
 
-I _should_ spend at most one day per challenge but I refuse to use
-external solutions so I may spend more time on each challenge, hence the
-deadline being 30/11 rather than 25/11.  Of course, I am not restricting
-myself to doing one challenge a day - that would be a waste of my time
-considering they're all released.  I doubt, however, that I'll be able
-to finish _earlier_ than my deadline.
-
-I want to do this advent of code in more than one language if possible.
-Here is a list of all the languages I am aware of enough to program in,
-ordered from least to most confidence:
-
-- (0) POSIX Shell
-- (0) Haskell
-- (0) Ocaml
-- (0) Rust
-- (0) Racket
-- (0) JavaScript/TypeScript
+- (1) POSIX Shell
+- (2) Haskell
+- (3) Ocaml
+- (4) Racket
+- (5) Rust
+- (6) JavaScript/TypeScript
 - (0) Common Lisp
 - (0) C
 - (0) Python

2015/puzzle-4.rkt

@@ -0,0 +1,20 @@
+#lang racket
+
+(require racket/file)
+(require file/md5)
+
+(define input (file->string "4-input"))
+
+(define (find-salt requested-string current)
+  (let* ([full-message (string-append input (number->string current))]
+         [hash (bytes->string/locale (md5 full-message))])
+    (if (string-prefix? hash requested-string)
+        current
+        (find-salt requested-string (+ current 1)))))
+
+(printf "Round 1: ~a~%" (find-salt "00000"  0))
+(printf "Round 2: ~a~%" (find-salt "000000" 0))
+
+;; Local Variables:
+;; compile-command: "racket puzzle-4.rkt"
+;; End:

2015/puzzle-5.rs

@@ -0,0 +1,80 @@
+use std::fs;
+
+const VOWELS_STR: &str = "aeiou";
+const DO_NOT_WANT: [&str; 4] = ["ab", "cd", "pq", "xy"];
+
+fn is_nice_round1(line: &str) -> bool {
+    let mut unwanted_substr = false;
+    let mut has_consecutive = false;
+    let mut vowels = 0;
+    for i in 0..line.len() - 1 {
+        let slide: &str = &line[i..i + 2];
+        if DO_NOT_WANT.iter().position(|&x| x == slide).is_some() {
+            unwanted_substr = true;
+            break;
+        }
+        let first = slide.chars().nth(0).unwrap();
+        let second = slide.chars().nth(1).unwrap();
+        if VOWELS_STR.contains(first) {
+            vowels += 1;
+        }
+        if first == second {
+            has_consecutive = true;
+        }
+    }
+
+    if VOWELS_STR.contains(line.chars().nth(line.len() - 1).unwrap()) {
+        vowels += 1;
+    }
+
+    if unwanted_substr {
+        return false;
+    }
+    return vowels >= 3 && has_consecutive;
+}
+
+fn is_nice_round2(line: &str) -> bool {
+    /*
+    Justifying the O(|line|^2) runtime is easy: |line| is constant, such that at
+    worst we're doing roughly O(256) iterations.  Not too bad.
+
+    If |line| could be really big I'd look into optimising the rest, but why do
+    that?
+     */
+    let mut has_pair = false;
+
+    // Unfortunate O(|line|^2) runtime
+    for i in 0..line.len() - 1 {
+        let slide = &line[i..i + 2];
+        let rest = &line[i + 2..];
+        if rest.contains(slide) {
+            has_pair = true;
+            break;
+        }
+    }
+
+    // O(|line|) runtime
+    let mut has_triple = false;
+    for i in 0..line.len() - 2 {
+        let slide = &line[i..i + 3];
+        if slide.chars().nth(0) == slide.chars().nth(2) {
+            has_triple = true;
+            break;
+        }
+    }
+
+    return has_pair && has_triple;
+}
+
+fn main() {
+    let binding = fs::read_to_string("5-input").expect("wget 5-input please.");
+    let contents: Vec<&str> = binding.split("\n").collect();
+    let nice_lines_1 = contents.iter().filter(|&x| is_nice_round1(x)).count();
+    let nice_lines_2 = contents.iter().filter(|&x| is_nice_round2(x)).count();
+    println!("Round 1: {nice_lines_1}");
+    println!("Round 2: {nice_lines_2}");
+}
+
+// Local Variables:
+// compile-command: "rustc puzzle-5.rs && ./puzzle-5"
+// End:

2015/puzzle-6.js

@@ -0,0 +1,83 @@
+const fs = require('node:fs/promises');
+
+let arr = []
+
+function count_1() {
+  return arr.filter(x => x).length;
+}
+
+function count_2() {
+  return arr.reduce((x, y) => x + y);
+}
+
+async function read_file() {
+  const data = await fs.readFile("6-input", {encoding: 'utf8'});
+  return data;
+}
+
+function parse_line(line) {
+  let [type, ...rest] = line.split(" ")
+  let obj = {type: "", bottom: [], top: []};
+  if (type === "toggle") {
+    obj.type = "toggle";
+  } else {
+    obj.type = rest[0];
+    rest = rest.slice(1);
+  }
+  obj.bottom = rest[0].split(",").map(x => parseInt(x));
+  obj.top = rest[2].split(",").map(x => parseInt(x));
+  return obj
+}
+
+function execute_inst_1(inst) {
+  for (let i = inst.bottom[0]; i <= inst.top[0]; ++i) {
+    for (let j = inst.bottom[1]; j <= inst.top[1]; ++j) {
+      if (inst.type === "on") {
+        arr[(i * 1000) + j] = true;
+      } else if (inst.type === "off") {
+        arr[(i * 1000) + j] = false;
+      } else {
+        arr[(i * 1000) + j] = !arr[(i * 1000) + j];
+      }
+    }
+  }
+}
+
+function execute_inst_2(inst) {
+  for (let i = inst.bottom[0]; i <= inst.top[0]; ++i) {
+    for (let j = inst.bottom[1]; j <= inst.top[1]; ++j) {
+      if (inst.type === "on") {
+        arr[(i * 1000) + j] += 1;
+      } else if (inst.type === "off") {
+        arr[(i * 1000) + j] = Math.max(0, arr[(i * 1000) + j] - 1);
+      } else {
+        arr[(i * 1000) + j] += 2;
+      }
+    }
+  }
+}
+
+(async () => {
+  let lines = (await read_file()).split(/\n/);
+  const insts = lines.map(parse_line);
+
+  for (let i = 0; i < 1000000; ++i) {
+    arr.push(false);
+  }
+  for (let i = 0; i < insts.length; ++i) {
+    execute_inst_1(insts[i]);
+  }
+  console.log("Round 1:", count_1());
+
+  for (let i = 0; i < 1000000; ++i) {
+    arr[i] = 0;
+  }
+  for (let i = 0; i < insts.length; ++i) {
+    execute_inst_2(insts[i]);
+  }
+  console.log("Round 2:", count_2());
+})()
+
+// Local Variables:
+// compile-command: "node puzzle-6.js"
+// End:

2024/puzzle-1.lisp

@@ -0,0 +1,15 @@
+(load "util.lisp")
+
+(--> (uiop:read-file-lines "1-input")
+     (loop for line in _
+           for x = (search "   " line)
+           collect (parse-integer (subseq line 0 x)) into left
+           collect (parse-integer (subseq line (+ x 3))) into right
+           finally (return (list (sort left #'<) (sort right #'<))))
+     (format t "Round 1: ~a~%Round 2: ~a~%"
+             (loop for x in (car _)
+                   for y in (cadr _)
+                   sum (abs (- y x)))
+             (loop for item in (car _)
+                   for count = (count item (cadr _))
+                   sum (* item count))))

2024/puzzle-2.py

@@ -0,0 +1,43 @@
+lines = []
+with open("2-input", "r") as fp:
+    lines = fp.readlines()
+
+levels = [list(map(int, line.strip().split(" "))) for line in lines]
+
+def is_good_level_1(level):
+    # 1) Is decreasing
+    # 2) Sliding window of two cells (x, y) => 1 <= |x-y| <= 3
+    # figure out if decreasing from first two
+    decreasing = level[0] > level[1]
+    for i in range(len(level) - 1):
+        x = level[i]
+        y = level[i + 1]
+        diff = abs(x - y)
+        if (decreasing and x < y) or (not decreasing and x > y) or not (diff <= 3 and diff >= 1):
+            return False
+    return True
+
+good_levels = [level for level in levels if is_good_level_1(level)]
+print(f"Round 1: {len(good_levels)}")
+
+def check_two_levels(x, y, decreasing):
+    diff = abs(x - y)
+    return not ((decreasing and x < y)\
+           or (not decreasing and x > y) \
+           or not (diff <= 3 and diff >= 1))
+
+def is_good_level_2(level):
+    # 1) Is decreasing
+    # 2) Sliding window of two cells (x, y) => 1 <= |x-y| <= 3
+    # 3) Can remove any one item to make it safe
+    if is_good_level_1(level):
+        return True
+    # Consider slices of the level and check if they're good
+    slices = [level[:i] + level[i + 1:] for i in range(len(level))]
+    for s in slices:
+        if is_good_level_1(s):
+            return True
+    return False
+
+good_levels = [level for level in levels if is_good_level_2(level)]
+print(f"Round 2: {len(good_levels)}")

2024/puzzle-3.lisp

@@ -0,0 +1,59 @@
+(load "util.lisp")
+
+(defparameter input (uiop:read-file-string "3-input"))
+
+(defun is-good-mul (str)
+  (let ((start (search "(" str))
+        (middle (search "," str))
+        (end (search ")" str)))
+    (and (not (null start)) (not (null middle)) (not (null end))
+         ;; mul( <- 3 character
+         (eq start 3)
+         ;; Simple to understand
+         (< start end)
+         (< start middle)
+         (< middle end)
+         ;; Make sure the arguments are purely numbers
+         (every #'digit-char-p (subseq str (1+ start) middle))
+         (every #'digit-char-p (subseq str (1+ middle) end)))))
+
+(defun parse-mul (str)
+  (let ((start (search "(" str))
+        (middle (search "," str))
+        (end (search ")" str)))
+    (list (parse-integer (subseq str (1+ start) middle))
+          (parse-integer (subseq str (1+ middle) end)))))
+
+(defun parse-input-muls (line)
+  (let ((possible (search-all "mul" line)))
+    (--> (cdr possible)
+         (append _ (list (length line)))
+         ;; index of mul -> (position substring)
+         (mapcar (lambda (z1 z2) (cons z1 (subseq line z1 z2))) possible _)
+         ;; remove any bad muls
+         (remove-if-not (lambda (x) (is-good-mul (cdr x))) _)
+         ;; parse muls
+         (mapcar (lambda (x) (cons (car x) (parse-mul (cdr x)))) _))))
+
+(format t "Round 1: ~a~%"
+        (loop for (pos x y) in (parse-input-muls input)
+              sum (* x y)))
+
+(defun parse-input-conds (input)
+  (let ((dos (search-all "do()" input))
+        (donts (search-all "don't()" input)))
+    (--> (append (mapcar (lambda (x) (cons 'do x)) dos)
+                 (mapcar (lambda (x) (cons 'dont x)) donts))
+         (sort _ (lambda (x y) (< (cdr x) (cdr y))))
+         (cons '(do . 0) _))))
+
+(defun current-cond (pos conds)
+  (caar (last (remove-if (lambda (x) (> (cdr x) pos)) conds))))
+
+(format t "Round 2: ~a~%"
+        (let ((conds (parse-input-conds input))
+              (muls (parse-input-muls input)))
+          (loop for (pos x y) in muls
+                for current = (current-cond pos conds)
+                if (eq current 'do)
+                  sum (* x y))))

2024/util.lisp

@@ -0,0 +1,20 @@
+(defmacro --> (first &rest functions)
+  (if (null functions)
+      first
+      `(let* ,(loop :for f :in (cons first functions)
+                    :appending `((_ ,f)))
+         _)))
+
+(defun search-all (substr str &optional acc len)
+  (let ((x (search substr str))
+        (len (or len 0)))
+    (if (null x)
+        (reverse acc)
+        (search-all substr (subseq str (1+ x))
+                    (cons (+ x len) acc)
+                    (+ len x 1)))))
+
+  (defun zip (a b)
+    (loop for i in a
+          for j in b
+          collect (cons i j)))

2025/puzzle-1.lisp

@@ -0,0 +1,40 @@
+(load "util.lisp")
+
+(defpackage "aoc:1"
+  (:use :cl "aoc-util"))
+
+(in-package "aoc:1")
+
+(fn round-1 (turns) (=> list fixnum)
+  (loop with dial = 50
+        with number-of-zeros = 0
+        for (rotation . magnitude) in turns
+        do (setf dial (mod (funcall rotation dial magnitude) 100))
+        if (= dial 0)
+          do (incf number-of-zeros)
+        finally (return number-of-zeros)))
+
+(fn round-2 (turns) (=> list fixnum)
+  (loop with dial = 50
+        with number-of-zeros = 0
+        for (rotation . magnitude) in turns
+        ;; FUCK I have to do this manually, too many edge cases
+        do (loop for i from 1 to magnitude
+                 for new-dial-value = (funcall rotation dial 1)
+                 if (or (= new-dial-value 0) (= new-dial-value 100))
+                   do (incf number-of-zeros)
+                 do (setf dial (mod new-dial-value 100)))
+        finally (return number-of-zeros)))
+
+(let ((turns (loop for line in (uiop:read-file-lines "1-input")
+                   for (rotation magnitude) = (->> line (split 1) multiple-value-list)
+                   collect (cons (if (string= rotation "L")
+                                     #'-
+                                     #'+)
+                                 (parse-integer* magnitude)))))
+  (->> turns
+       round-1
+       (format t "Round 1: ~a~%"))
+  (->> turns
+       round-2
+       (format t "Round 2: ~a~%")))

2025/puzzle-2.lisp

@@ -0,0 +1,64 @@
+(load "util.lisp")
+
+(defpackage "aoc:2"
+  (:use :cl "aoc-util"))
+
+(in-package "aoc:2")
+
+(fn parse-input (filename) (=> string list)
+  (loop for item in (-<> (uiop:read-file-string filename)
+                         (uiop:split-string :separator '(#\,)))
+        for split-range = (uiop:split-string item :separator '(#\-))
+        collect (mapcar ($>> (string-trim '(#\space)) parse-integer*) split-range)))
+
+(fn invalid-id-1 (n) (=> fixnum boolean)
+  (let ((str (format nil "~a" n)))
+    (if (= 1 (mod (length str) 2))
+        nil
+        (let ((items (multiple-value-list (split (/ (length str) 2) str))))
+          (string= (car items) (cadr items))))))
+
+(fn round-1 (id-ranges) (=> list fixnum)
+  (loop with invalid-ids = 0
+        for (lower upper) in id-ranges
+        do (loop for i from lower to upper
+                 if (invalid-id-1 i)
+                   do (incf invalid-ids i))
+        finally (return invalid-ids)))
+
+(fn invalid-id-2 (n) (=> fixnum boolean)
+  (loop
+    ;; Loop setup
+    with str = (format nil "~a" n)
+    with window-len = 1
+    with window-str = (subseq str 0 1)
+    with i = 1
+
+    while (< i (length str))
+    for chunk = (subseq str i (min (length str) (+ i window-len)))
+    if (< (length chunk) window-len)
+      return nil
+    if (string= chunk window-str)
+      ;; check the next chunk
+      do (incf i window-len)
+    else
+      ;; we need to increase the size of our window
+      do (setf window-len (1+ i)
+               window-str (subseq str 0 window-len)
+               i (1+ i))
+    finally (return (->> str length (= window-len) not))))
+
+(fn round-2 (id-ranges) (=> list fixnum)
+  (->> id-ranges
+       (mapcar (lambda (range) (range (car range) (cadr range))))
+       (mapcar ($>> (remove-if-not #'invalid-id-2)))
+       (mapcar ($>> (reduce #'+)))
+       (reduce #'+)))
+
+(let ((input (parse-input "2-input")))
+  (->> input
+       round-1
+       (format t "Round 1: ~a~%"))
+  (->> input
+       round-2
+       (format t "Round 2: ~a~%")))

2025/puzzle-3.lisp

@@ -0,0 +1,65 @@
+(load "util.lisp")
+
+(defpackage "aoc:3"
+  (:use :cl "aoc-util"))
+
+(in-package "aoc:3")
+
+(fn compose-joltage (x y) (=> (integer integer) integer)
+  (->> x (* 10) (+ y)))
+
+(fn maximum (xs) (=> list cons)
+  (--> _
+    (loop for x in xs maximizing x)
+    (cons _ (position _ xs))))
+
+(fn best-joltage-1 (bank) (=> list cons)
+  (destructuring-bind (max-val . max-pos) (maximum bank)
+    (if (->> bank length 1- (= max-pos))
+        ;; best value at end => next best is the first digit
+        (cons (->> bank length 1-
+                   (subseq bank 0)
+                   maximum car)
+              max-val)
+        ;; best value not at end => next best is the second digit
+        (->> max-pos 1+
+             (subseq bank)
+             maximum car
+             (cons max-val)))))
+
+(fn round-1 (banks) (=> list fixnum)
+  (loop for bank in banks
+        for (first-digit . second-digit) = (best-joltage-1 bank)
+        sum (compose-joltage first-digit second-digit)))
+
+(fn best-joltage-2 (bank) (=> list fixnum)
+  #| Sliding window greedy search?
+
+  We look at a sequence of digits in bank, choose the best one, then move onto
+  the next window.  We need the windows, at all times, to have enough digits for
+  us to pick a good one from.  In this case we need to choose 12, so at any one
+  time we need to be examining at most 12 digits (decrementing as we get more
+  digits).  The next window needs to be _after_ the position of the best value
+  we picked in our current window.  |#
+  (loop
+    with window-start = 0
+    for n from 12 downto 1
+    for window = (subseq bank window-start (-<> bank length 1+ (- n)))
+    for (max-val . max-pos) = (maximum window)
+    do (setf window-start (+ max-pos 1 window-start))
+    collect max-val into digits
+    finally (return (reduce #'compose-joltage digits))))
+
+(fn round-2 (banks) (=> list integer)
+  (->> banks (mapcar #'best-joltage-2) (reduce #'+)))
+
+(let ((input (loop for line in (uiop:read-file-lines "3-input")
+                   for chars = (coerce line 'list)
+                   for digit-strings = (mapcar #'string chars)
+                   collect (mapcar #'parse-integer* digit-strings))))
+  (->> input
+       round-1
+       (format t "Round 1: ~a~%"))
+  (->> input
+       round-2
+       (format t "Round 2: ~a~%")))

2025/puzzle-4.lisp

@@ -0,0 +1,75 @@
+(load "util.lisp")
+
+(defpackage "aoc:4"
+  (:use :cl "aoc-util"))
+
+(in-package "aoc:4")
+
+(fn valid-cell-coord (graph x y) (=> (list fixnum fixnum) boolean)
+  (and (>= x 0) (< x (length graph))
+       (>= y 0) (< y (length (car graph)))))
+
+(fn get-cell (graph x y) (=> (list fixnum fixnum) (or null character))
+  (if (valid-cell-coord graph x y)
+      (->> graph (nth x) (nth y))
+      nil))
+
+(fn adjacent-cell-coords (graph x y) (=> (list fixnum fixnum) cons)
+  (loop
+    for x_ from (1- x) to (1+ x)
+    nconc
+    (loop
+      for y_ from (1- y) to (1+ y)
+      for cell = (get-cell graph x_ y_)
+      if cell
+        collect (list x_ y_ cell))))
+
+(fn get-rolls-with-adjacent-rolls (graph) (=> list cons)
+  (loop
+    for x from 0
+    for row in graph
+    nconc
+    (loop
+      for y from 0
+      for cell in row
+      if (char= cell #\@)
+        collect
+        (->> (adjacent-cell-coords graph x y)
+             (remove-if-not ($>> (nth 2) (char= #\@)))
+             length
+             (list x y)))))
+
+
+(fn get-good-rolls (graph) (=> list list)
+  (->> graph
+       get-rolls-with-adjacent-rolls
+       (remove-if ($>> (nth 2) (< 4)))))
+
+(fn round-1 (graph) (=> list fixnum)
+  (->> graph
+       get-good-rolls
+       length))
+
+(fn remove-cells (graph cells) (=> (list list) list)
+  (loop for (x y) in cells
+        do (setf (->> graph (nth x) (nth y)) #\.))
+  graph)
+
+(fn round-2 (graph) (=> list fixnum)
+  (loop
+    for good-rolls = (get-good-rolls graph)
+    while (/= (length good-rolls) 0)
+    sum (length good-rolls)
+    do (->> good-rolls
+            (mapcar ($<> (subseq 0 2)))
+            (remove-cells graph)
+            (setf graph))))
+
+(let ((input (->> (uiop:read-file-lines "4-input")
+                  (mapcar #'(lambda (x) (coerce x 'list))))))
+  (->> input
+       round-1
+       (format t "Round 1: ~a~%"))
+  (->> input
+       round-2
+       (format t "Round 2: ~a~%")))

2025/puzzle-5.lisp

@@ -0,0 +1,50 @@
+(load "util.lisp")
+
+(defpackage "aoc:5"
+  (:use :cl "aoc-util"))
+
+(in-package "aoc:5")
+
+(fn parse-input (input) (=> list (values list list))
+  (let ((input (-<> (position "" input :test #'string=)
+                    (split input)
+                    multiple-value-list)))
+    (values
+     (loop for range in (car input)
+           for bounds = (uiop:split-string range :separator '(#\-))
+           collect (mapcar #'parse-integer* bounds))
+     (mapcar #'parse-integer* (cdadr input)))))
+
+(fn in-range (n range) (=> (integer list) boolean)
+  (destructuring-bind (lower upper) range
+    (and (<= n upper) (>= n lower))))
+
+(fn round-1 (ranges items) (=> (list list) fixnum)
+  (loop
+    for item in items
+    sum
+    (loop
+      for range in ranges
+      if (in-range item range)
+        return 1
+      finally (return 0))))
+
+(fn round-2 (ranges) (=> list integer)
+  (loop
+    with ranges = (sort ranges #'(lambda (x y) (< (car x) (car y))))
+    with end = 0
+    for (lower upper) in ranges
+    if (> lower end)
+      sum (1+ (- upper lower))          ;add the size of the range to our running total
+      and do (setf end upper)           ;make the end of our current range the upper bound
+    else
+      ;; (lower, upper) contained in ranges => remove the intersect
+      sum (- (max upper end) end)
+      and do (setf end (max upper end))))
+
+(let ((input (uiop:read-file-lines "5-input")))
+  (multiple-value-bind (ranges items) (parse-input input)
+    (->> (round-1 ranges items)
+         (format t "Round 1: ~a~%"))
+    (->> (round-2 ranges)
+         (format t "Round 2: ~a~%"))))

2025/puzzle-6.lisp

@@ -0,0 +1,99 @@
+(load "util.lisp")
+
+(defpackage "aoc:6"
+  (:use :cl "aoc-util"))
+
+(in-package "aoc:6")
+
+;; Computation, once we have everything parsed, is trivial...
+(fn compute (operand-sets ops) (=> (list list) fixnum)
+  (loop for operands in operand-sets
+        for op in ops
+        sum (apply op operands)))
+
+;; What do you think this does?
+(fn transpose (matrix) (=> list list)
+  (loop for i from 1 to (length (car matrix))
+        collect
+        (loop
+          for row in matrix
+          collect (nth (1- i) row))))
+
+(fn parse-op (op) (=> string function)
+  (if (string= op "+") #'+ #'*))
+
+(fn parse-input (filename) (=> string (values list list))
+  ;; Returns (lines representing operands, parsed operators)
+  (let* ((lines (uiop:read-file-lines filename))
+         (last (car (last lines))))
+    (values (->> lines length 1-
+                 (subseq lines 0))
+            (->> last
+                 uiop:split-string
+                 (remove-if ($>> (string= "")))
+                 (mapcar #'parse-op)))))
+
+;; The end of triviality
+(fn parse-operand-sets-1 (operand-sets) (=> list list)
+  (->>
+   ;; Split every line in operand-sets by whitespace, deleting any trivial
+   ;; strings
+   (loop for op-set in operand-sets
+         collect (->>
+                  op-set
+                  uiop:split-string
+                  (remove-if ($>> (string= "")))))
+   ;; transpose the operand set to get the right operands
+   transpose
+   ;; parse the integers contained in every op-set
+   (mapcar ($>> (mapcar #'parse-integer)))))
+
+(fn is-separator? (op-sets col) (=> (list fixnum) boolean)
+  ;; Given a column, whitespace on every row => it's not a value
+  (every (lambda (c) (char= c #\space))
+     (loop for row in op-sets
+           collect (nth col row))))
+
+(fn parse-operand-sets-2 (operand-sets) (=> list list)
+  ;; converts operand-sets into that weird cephalopod writing system
+
+  ;; convert op-sets into a list of lists of chars
+  (let ((op-sets (mapcar ($<> (coerce 'list)) operand-sets))
+        columns)
+    (loop
+      with col-size = (length (car op-sets))
+      with index = 0
+      while (< index (col-size op-sets))
+
+      ;; Skip any separators
+      do
+      (loop while (and (< index col-size)
+                       (is-separator? op-sets index))
+            do (incf index))
+
+      ;; Extract a column till the next separator
+      do
+      (loop while (and (< index col-size)
+                       (not (is-separator? op-sets index)))
+            collect (loop for row in op-sets collect (nth index row)) into xs
+            do (incf index)
+            finally (setf columns (append columns (list xs)))))
+
+    ;; Columns is now a set of groups of columns (by separator).  Each item in a
+    ;; group is a set of characters.  Let's clean that up into groups of
+    ;; integers.
+    (-<> ($>>
+          (mapcar ($>> (call-rev coerce 'string)
+                  parse-integer*)))
+         (mapcar columns))))
+
+(multiple-value-bind (operand-sets ops) (parse-input "6-input")
+  (->> operand-sets
+       parse-operand-sets-1
+       (call-rev compute ops)
+       (format t "Round 1: ~a~%"))
+
+  (->> operand-sets
+       parse-operand-sets-2
+       (call-rev compute ops)
+       (format t "Round 2: ~a~%")))

2025/util.lisp

@@ -0,0 +1,157 @@
+(defpackage "aoc-util"
+  (:use :cl)
+  (:export
+   :=>
+   :--> :->> :-<>
+   :$-> :$<> :$>>
+   :alist-val :call-rev :fn
+   :split :rev-map :parse-integer* :remove-at-indices :range))
+
+(in-package "aoc-util")
+
+(deftype => (args result)
+  "Type level DSL for function types"
+  `(function ,(typecase args
+                (null args)
+                (symbol (list args))
+                (otherwise args))
+             ,result))
+
+(defmacro --> (placeholder &body forms)
+  "Lexically bind current form as `placeholder' for use in the next form, returning
+the result of the last form.
+
+i.e.
+
+(--> (a1 a2...) (b1 b2...) (c1 c2...)) =
+(let* ((placeholder (a1 a2 ...))
+       (placeholder (b1 b2 ...))
+       (placeholder (c1 c2 ...)))
+    _ )
+
+Also includes transformer where symbols are considered unary functions i.e.
+(--> x y) <-> (--> x (y placeholder)).
+"
+  (if (null forms)
+      nil
+      (let ((assignment-forms
+              (loop :for i :from 0
+                    :for f :in forms
+                    :for canon-f := (if (and (> i 0) (symbolp f))
+                                        (list f placeholder)
+                                        f)
+                    :collect `(,placeholder ,canon-f))))
+        `(let* ,assignment-forms
+           ,placeholder))))
+
+(defmacro ->> (&rest forms)
+  "Make current form the last argument of the next form, returning the last
+  form.
+
+i.e.
+(->> (a1 a2...) (b1 b2...) (c1 c2...)) == (c1 c2 ... (b1 b2 ... (a1 a2 ...)))
+
+Also includes transformer where symbols are considered unary functions.
+
+Like the `|>' operator in Ocaml."
+  (if (null forms)
+      nil
+    (loop :with acc = (car forms)
+          :for func :in (cdr forms)
+          :for canon-func = (if (symbolp func) (list func) func)
+          :do (setq acc (append canon-func (list acc)))
+          :finally (return acc))))
+
+(defmacro -<> (&rest forms)
+  "Make current form the first argument of the next form, returning the last
+  form.
+
+i.e.
+(-<> (a1 a2...) (b1 b2...) (c1 c2...)) == (c1 (b1 (a1 a2 ...) b2 ...) c2 ...)
+
+Also includes transformer where symbols are considered unary functions.
+
+Like the `|>' operator in Ocaml."
+  (if (null forms)
+      nil
+      (loop :with acc = (car forms)
+            :for func :in (cdr forms)
+            :for canon-func = (if (symbolp func) (list func) func)
+            :do (push acc (cdr canon-func))
+            :do (setq acc canon-func)
+            :finally (return acc))))
+
+(defmacro $-> (capture &rest forms)
+  "Given a sequence of FORMS, return a unary function which applies each form
+sequentially via -->"
+  `(lambda (,capture)
+     (--> ,capture ,capture ,@forms)))
+
+(defmacro $<> (&rest forms)
+  "Given a sequence of FORMS, return a unary function which applies each form
+sequentially via -<>"
+  (let ((capture (gensym)))
+    `(lambda (,capture)
+       (-<> ,capture ,@forms))))
+
+(defmacro $>> (&rest forms)
+  "Given a sequence of FORMS, return a unary function which applies each form
+sequentially via ->>"
+  (let ((capture (gensym)))
+    `(lambda (,capture)
+       (->> ,capture ,@forms))))
+
+(defmacro alist-val (key alist &key (test #'eq))
+  "Helper macro for getting the value of KEY in ALIST."
+  `(cdr (assoc ,key ,alist :test ,test)))
+
+(defmacro call-rev (func-name &rest arguments)
+  "Call a function with arguments but in reverse
+i.e. (call-rev f x1 x2 ... xn) => (f xn ... x2 x1)."
+  `(,func-name ,@(reverse arguments)))
+
+(defmacro fn (name lambda-list type &body body)
+  "Construct a function `NAME' with a declared function type `TYPE' that takes
+arguments `LAMBDA-LIST' with body `BODY'."
+  `(progn
+     (declaim (ftype ,type ,name))
+     (defun ,name ,lambda-list
+       ,@body)))
+
+(fn split (n lst) (=> (fixnum sequence) (values sequence sequence))
+    "Return CONS where CAR is the first N elements of LST and CDR is the rest."
+    (if (< (length lst) n)
+        (values nil nil)
+        (values (subseq lst 0 n)
+                (subseq lst n))))
+
+(fn rev-map (indicator lst &key (test #'eq))
+    (=> (function sequence &key (:test function)) list)
+    "Given LST and INDICATOR: LST -> A, return an association list A -> 2^LST
+where key x in A has associations {y in LST : INDICATOR(y) = x}."
+    (loop :with assoc-list := nil
+          :for element :in (coerce lst 'list)
+          :for key := (funcall indicator element)
+          :for value := (cdr (assoc key assoc-list :test test))
+          :if value
+            :do (setf (alist-val key assoc-list :test test)
+                      (cons element value))
+          :else
+            :do (setq assoc-list (-<> (list key element) (cons assoc-list)))
+          :finally (return assoc-list)))
+
+(fn parse-integer* (inp) (=> string (or integer list))
+    "Given string INP, attempt to parse an integer.  Return NIL otherwise."
+    (parse-integer inp :junk-allowed t))
+
+(fn remove-at-indices (indices lst) (=> (list sequence) list)
+  "Given a set of INDICES and a list LST, return a copy of LST without items at any
+index in INDICES."
+  (loop :for i :from 0 :to (1- (length lst))
+        :for item :in (coerce lst 'list)
+        :if (not (member i indices))
+          :collect item))
+
+(fn range (lower upper) (=> (fixnum fixnum) list)
+  (loop for i from lower to upper
+        collect i))