Days 08--12

These days have been done while traveling, so they may be less modular
due to time/phone-screen constraints.

6 files changed, 468 insertions, 0 deletions

diff --git a/day08.scm b/day08.scm
new file mode 100644
index 0000000..a697de8
--- /dev/null
+++ b/day08.scm
@@ -0,0 +1,122 @@
+(define-module (day08)
+  #:use-module (ice-9 rdelim)
+  #:use-module (oop goops)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-43))
+
+(define-class <problem> ()
+  #| A description of the problem at hand. |#
+  (height #:init-value 0 #:accessor problem-height #| The height of the map. |#)
+  (width #:init-value 0 #:accessor problem-width #| The width of the map. |#)
+  (nodes #:init-thunk make-hash-table
+         #| A hashv that associates each letter that appears with a list of
+            positions of antennas, represented as (y, x) pairs. |#))
+
+(define-method (display (problem <problem>) port)
+  (define result
+    (list->vector
+     (list-tabulate (problem-height problem)
+                    (lambda (_i) (make-string (problem-width problem) #\.)))))
+  (define (add-dots c pts)
+    (unless (null? pts)
+      (when (and (< -1 (caar pts) (problem-height problem))
+                 (< -1 (cdar pts) (problem-width problem)))
+        (string-set! (vector-ref result (caar pts)) (cdar pts) c))))
+  (hash-for-each add-dots result)
+  (vector-for-each (cut write-line <> port) result))
+
+(define (problem-add! problem y x chr)
+  (define ht (slot-ref problem 'nodes))
+  (hashv-set! ht chr
+              (cons (cons y x) (hashv-ref ht chr '()))))
+
+(define (problem-nodes problem chr)
+  (hashv-ref (slot-ref problem 'nodes) chr '()))
+
+(define* (read-problem #:optional (port (current-input-port)))
+  (define problem (make <problem>))
+  (define (iter y w)
+    (define line (read-line))
+    (if (or (eof-object? line) (string= line ""))
+      (begin (set! (problem-width problem) w)
+	     (set! (problem-height problem) y))
+      (begin
+      (string-for-each-index
+	(lambda (i)
+	  (unless (char=? (string-ref line i) #\.)
+	    (problem-add! problem y i (string-ref line i))))
+	line)
+      (iter (+ y 1) (max w (string-length line))))))
+  (iter 0 0)
+  problem)
+
+(define (antinode n1 n2)
+  (cons (- (* 2 (car n2)) (car n1))
+	(- (* 2 (cdr n2)) (cdr n1))))
+
+(define (add-point! mp pt)
+  (when (array-in-bounds? mp (car pt) (cdr pt))
+    (array-set! mp 1 (car pt) (cdr pt))))
+
+(define (problem-count-anti-nodes problem)
+  (define mp (make-array 0 (problem-height problem)
+			 (problem-width problem)))
+  (define count 0)
+  (define (add-from poss)
+    (unless (null-list? poss)
+      (for-each
+	(lambda (t)
+	  (add-point! mp (antinode (car poss) t))
+	  (add-point! mp (antinode t (car poss))))
+	(cdr poss))
+      (add-from (cdr poss))))
+  (hash-for-each (lambda (chr poss) (add-from poss))
+		 (slot-ref problem 'nodes))
+  (array-for-each (lambda (x) (set! count (+ count x)))
+		  mp)
+  count)
+
+(define* (part1 #:optional (port (current-input-port)))
+	 (problem-count-anti-nodes (read-problem port)))
+
+(define (add-antinodes! mp n1 n2)
+  (define vy (- (car n2) (car n1)))
+  (define vx (- (cdr n2) (cdr n1)))
+  (define divider (gcd vx vy))
+  (define dy (/ vy divider))
+  (define dx (/ vx divider))
+  (define-values (h w) (apply values (array-dimensions mp)))
+  (define y1 (- (/ (car n1) dy)))
+  (define y2 (/ (- h 1 (car n1)) dy))
+  (define x1 (- (/ (cdr n1) dx)))
+  (define x2 (/ (- w 1 (cdr n1)) dx))
+  (define kstart (ceiling (max (min x1 x2) (min y1 y2))))
+  (define kend (floor (min (max x1 x2) (max y1 y2))))
+  (define (iter k)
+    (unless (> k kend)
+      (array-set! mp 1 (+ (car n1) (* k dy))
+		  (+ (cdr n1) (* k dx)))
+      (iter (+ k 1))))
+  (iter kstart))
+
+(define (problem-count-anti-nodes2 problem)
+  (define mp (make-array 0 (problem-height problem)
+			 (problem-width problem)))
+  (define count 0)
+  (define (add-from poss)
+    (unless (null-list? poss)
+      (for-each
+	(lambda (t)
+	  (add-antinodes! mp (car poss) t))
+	(cdr poss))
+      (add-from (cdr poss))))
+  (hash-for-each (lambda (chr poss) (add-from poss))
+		 (slot-ref problem 'nodes))
+  (array-for-each (lambda (x) (set! count (+ count x)))
+		  mp)
+  count)
+
+(define* (part2 #:optional (port (current-input-port)))
+	 (problem-count-anti-nodes2 (read-problem port)))
+
diff --git a/day09.scm b/day09.scm
new file mode 100644
index 0000000..640dcca
--- /dev/null
+++ b/day09.scm
@@ -0,0 +1,88 @@
+(define-module (day09)
+		#:use-module (ice-9 rdelim)
+		#:use-module (srfi srfi-9))
+
+(define (check-spot disk-offset file-id times)
+  ; n+(n+1)+...+(n+k-1)=k*(2*n+k-1)/2=k*(n+(k-1)/2)
+  (* file-id times (+ disk-offset (/ (- times 1) 2))))
+
+(define (num-at s pos)
+  (- (char->integer (string-ref s pos))
+     (char->integer #\0)))
+
+(define (compact-checksum s)
+  (define (iter-used offset sid eid etimes acc)
+    (if (= sid eid)
+      (+ acc (check-spot offset sid etimes))
+      (let ((times (num-at s (* 2 sid))))
+	(iter-free (+ offset times)
+		   sid
+		   (num-at s (+ 1 (* 2 sid)))
+		   eid
+		   etimes
+		   (+ acc (check-spot offset sid times))))))
+  (define (iter-free offset sprevid stimes eid etimes acc)
+    (cond ((= sprevid eid) acc)
+	  ((>= stimes etimes)
+	   (iter-free (+ offset etimes)
+		      sprevid
+		      (- stimes etimes)
+		      (- eid 1)
+		      (num-at s (* 2 (- eid 1)))
+		      (+ acc (check-spot offset eid etimes))))
+	  (else (iter-used (+ offset stimes)
+			   (+ sprevid 1)
+			   eid
+			   (- etimes stimes)
+			   (+ acc (check-spot offset eid stimes))))))
+  (define last-id (quotient (- (string-length s) 1) 2))
+  (iter-used 0 0 last-id (num-at s (* 2 last-id)) 0))
+
+(define* (part1 #:optional (input (current-input-port)))
+	 (compact-checksum (read-line input)))
+
+(define-record-type <zone> (zone offset length id) zone?
+  (offset zone-offset)
+  (length zone-length)
+  (id zone-id))
+
+(define (displace-free z n)
+  (zone (+ (zone-offset z) n)
+	(- (zone-length z) n)
+	(zone-id z)))
+
+(define (string->free+revused s)
+  (define (iter id off free used)
+    (if (>= (* 2 id) (string-length s))
+      (values (reverse free) used)
+      (let ((freelen (num-at s (- (* 2 id) 1)))
+	    (usedlen (num-at s (* 2 id))))
+        (iter (+ 1 id)
+	      (+ off freelen usedlen)
+	      (cons (zone off freelen #f) free)
+	      (cons (zone (+ off freelen) usedlen id) used)))))
+  (iter 1 (num-at s 0) '() (list (zone 0 (num-at s 0) 0))))
+
+(define (defrag-checksum free revused)
+  (define (iter-used lst sum)
+    (if (null? lst)
+      sum
+      (let ((off (zone-offset (car lst)))
+	    (len (zone-length (car lst))))
+	(define (reserve-free! lst)
+	  (cond ((null? lst) off)
+		((> (zone-offset (car lst)) off) off)
+		((>= (zone-length (car lst)) len)
+		 (let ((new-off (zone-offset (car lst))))
+		   (set-car! lst (displace-free (car lst) len))
+		   new-off))
+		(else (reserve-free! (cdr lst)))))
+	(define new-off (reserve-free! free))
+	(iter-used (cdr lst) (+ sum (check-spot new-off (zone-id (car lst)) len))))))
+  (iter-used revused 0))
+
+(define* (part2 #:optional (input (current-input-port)))
+	 (call-with-values (lambda () (string->free+revused (read-line input)))
+			   defrag-checksum))
+
+
diff --git a/day10.scm b/day10.scm
new file mode 100644
index 0000000..516331a
--- /dev/null
+++ b/day10.scm
@@ -0,0 +1,67 @@
+(define-module (day10)
+	       #:use-module (ice-9 rdelim)
+	       #:use-module (srfi srfi-1))
+
+(define (read-input port)
+  (define (iter acc)
+    (define line (read-line port))
+    (if (or (eof-object? line) (string= "" line))
+      (list->typed-array 'u8 2 (reverse acc))
+      (iter (cons (map
+		    (lambda (c) (- (char->integer c) (char->integer #\0)))
+		    (string->list line))
+		  acc))))
+  (iter '()))
+
+(define (dp! inp mp num join cellinit)
+  (define-values (m n) (apply values (array-dimensions inp)))
+  (unless (negative? num)
+   (let iter-row ((i 0))
+     (unless (= i m)
+       (let iter-cell ((j 0))
+	 (unless (= j n)
+	   (when (= num (array-ref inp i j))
+	     (array-set! 
+	       mp
+	       (fold (lambda (di dj acc)
+		       (if (and (array-in-bounds? inp (+ i di) (+ j dj))
+				(= (+ 1 num) (array-ref inp (+ i di) (+ j dj))))
+			 (join
+				  acc (array-ref mp (+ i di) (+ j dj)))
+			 acc))
+		     cellinit
+		     '(1 -1 0 0) '(0 0 1 -1))
+	       i j))
+	   (iter-cell (+ j 1))))
+       (iter-row (+ i 1))))
+   (dp! inp mp (- num 1) join cellinit)))
+
+(define (doit port score join cellinit 9init)
+  (define inp (read-input port))
+  (define-values (m n) (apply values (array-dimensions inp)))
+  (define mp (make-array 0 m n))
+  (define idx 0)
+  (array-map! mp (lambda (s) (if (= s 9) (9init) cellinit)) inp)
+  (dp! inp mp 8 join cellinit)
+  ;(display mp)
+  (let iter-row ((i 0) (acc 0))
+    (if (= i m)
+      acc
+      (iter-row (+ i 1)
+		(let iter-cell ((j 0) (acc acc))
+		  (if (= j n)
+		    acc
+		    (iter-cell (+ j 1)
+			       (+ acc (if (= (array-ref inp i j) 0)
+					(score (array-ref mp i j))
+					0)))))))))
+
+(define (part1 port)
+  (define idx 0)
+  (doit port length (lambda (a b) (lset-union = a b))
+	'()
+(lambda () (set! idx (+ idx 1)) (list idx))))
+
+(define (part2 port)
+  (doit port values + 0 (lambda () 1)))
+
diff --git a/day11.scm b/day11.scm
new file mode 100644
index 0000000..76ca159
--- /dev/null
+++ b/day11.scm
@@ -0,0 +1,72 @@
+(define-module (day11)
+	       #:use-module (ice-9 rdelim))
+
+(define (part1 port)
+  (define line (read-line port))
+  (define nums (map string->number (string-split line #\space)))
+  (define (blink lst acc)
+    (if (null? lst) 
+      (reverse acc)
+      (blink (cdr lst)
+	     (if (zero? (car lst))
+	       (cons 1 acc)
+	       (let ((s (number->string (car lst))))
+		 (if (even? (string-length s))
+		   (cons (string->number (substring s (/ (string-length s) 2)))
+			 (cons (string->number (substring s 0 (/ (string-length s) 2)))
+			       acc))
+		   (cons (* (car lst) 2024) acc)))))))
+  (define (iter lst left)
+    (if (zero? left)
+      (length lst)
+      (iter (blink lst '()) (- left 1))))
+  (iter nums 25))
+
+(define memo (make-hash-table))
+
+(define (next0 num)
+  (if (zero? num)
+    (list 1)
+    (let* ((s (number->string num))
+	   (len (string-length s)))
+      (if (even? len)
+	(list (string->number (substring s 0 (/ len 2)))
+	      (string->number (substring s (/ len 2))))
+	(list (* num 2024))))))
+
+(define (next num)
+  (define val (hashv-ref memo num))
+  (if val
+    val
+    (let ((comp (next0 num)))
+      (hashv-set! memo num comp)
+      comp)))
+
+(define (step ht)
+  (define new (make-hash-table))
+  (hash-for-each
+    (lambda (num amt)
+      (for-each
+	(lambda (v)
+	  (hashv-set! new v
+		      (+ (hashv-ref new v 0) amt)))
+	(next num)))
+    ht)
+  new)
+
+(define (part2 port)
+  (define line (read-line port))
+  (define nums (map string->number (string-split line #\space)))
+  (define ht (make-hash-table))
+  (for-each (lambda (n)
+	      (hashv-set! ht n
+			 (+ 1 (hashv-ref ht n 0))))
+	    nums)
+  (define (iter ht left)
+    (if (zero? left)
+      (let ((cnt 0))
+	(hash-for-each (lambda (k v) (set! cnt (+ cnt v)))
+		       ht)
+	cnt)
+      (iter (step ht) (- left 1))))
+  (iter ht 75))
diff --git a/day12.scm b/day12.scm
new file mode 100644
index 0000000..e48c433
--- /dev/null
+++ b/day12.scm
@@ -0,0 +1,115 @@
+(define-module (day12)
+	       #:use-module (ice-9 rdelim)
+	       #:use-module (srfi srfi-1))
+
+(define (read-input port)
+  (define (iter acc)
+    (define line (read-line port))
+    (if (or (eof-object? line) (string= line ""))
+      acc
+      (iter (cons (string->list line) acc))))
+  (list->array 2 (reverse (iter '()))))
+
+(define (rectangle-fold proc init x0 xpast y0 ypast)
+  (let yloop ((y y0) (result init))
+    (if (>= y ypast)
+        result
+        (let xloop ((x x0) (result result))
+          (if (>= x xpast)
+              (yloop (+ y 1) result)
+              (xloop (+ x 1) (proc x y result)))))))
+
+(define (add-margin input)
+  (define-values (h w) (apply values (array-dimensions input)))
+  (define result
+    (make-array #\space (list -1 h) (list -1 w)))
+  (rectangle-fold
+    (lambda (i j acc)
+      (array-set! result (array-ref input i j) i j))
+    #f 0 h 0 w)
+  result)
+
+(define (get-area mp visited i j)
+  (define c (array-ref mp i j))
+  (array-set! visited #t i j)
+  (fold (lambda (di dj acc)
+	  (define ni (+ i di))
+	  (define nj (+ j dj))
+	  (if (or (array-ref visited ni nj)
+		  (not (char=? c (array-ref mp ni nj))))
+	    acc
+	    (+ acc (get-area mp visited ni nj))))
+	1 '(1 -1 0 0) '(0 0 1 -1)))
+
+(define (set-area! mp areas val i j)
+  (define c (array-ref mp i j))
+  (when (zero? val) (error "Zero val!"))
+  (array-set! areas val i j)
+  (fold (lambda (di dj acc)
+	  (define ni (+ i di))
+	  (define nj (+ j dj))
+	  (when (and (zero? (array-ref areas ni nj))
+		     (char=? c (array-ref mp ni nj)))
+	    (set-area! mp areas val ni nj)))
+	#f '(1 -1 0 0) '(0 0 1 -1)))
+
+(define (get-areas mp h w)
+  (define result (make-array 0 (list -1 h) (list -1 w)))
+  (define visited (make-array #f (list -1 h) (list -1 w)))
+  (rectangle-fold (lambda (i j acc)
+		    (unless (array-ref visited i j)
+		      (set-area! mp result
+				 (get-area mp visited i j)
+				 i j)))
+		  #f 0 h 0 w)
+  result)
+
+(define (get-costs mp areas h w)
+  (rectangle-fold
+    (lambda (i j acc)
+      (define c (array-ref mp i j))
+      (+ acc
+	 (if (char=? c (array-ref mp (+ i 1) j))
+	   0
+	   (+ (array-ref areas i j) (array-ref areas (+ i 1) j)))
+	 (if (char=? c (array-ref mp i (+ j 1)))
+	   0
+	   (+ (array-ref areas i j) (array-ref areas i (+ j 1))))))
+    0 -1 h -1 w))
+
+(define (part1 port)
+  (define input (read-input port))
+  (define-values (h w) (apply values (array-dimensions input)))
+  (define mp (add-margin input))
+  (define areas (get-areas mp h w))
+  (get-costs mp areas h w))
+
+(define (get-discount-costs mp areas h w)
+  (define (count di dj)
+    (define visited
+      (make-array #f (list -1 h) (list -1 w)))
+    (define (visit! i j c)
+      (unless (or (not (char=? c (array-ref mp i j)))
+		  (char=? c (array-ref mp (+ i di) (+ j dj))))
+	(array-set! visited #t i j)
+	(visit! (if (zero? di) (+ i 1) i)
+		(if (zero? dj) (+ j 1) j) c)))
+    (lambda (i j acc)
+      (if (array-ref visited i j)
+	acc
+	(let ((c (array-ref mp i j)))
+	  (if (char=? c (array-ref mp (+ i di) (+ j dj)))
+	    acc
+	    (begin (visit! i j c)
+		   (+ acc (array-ref areas i j))))))))
+  (+ (rectangle-fold (count -1 0) 0 0 h 0 w)
+     (rectangle-fold (count 1 0) 0 0 h 0 w)
+     (rectangle-fold (count 0 -1) 0 0 h 0 w)
+     (rectangle-fold (count 0 1) 0 0 h 0 w)))
+
+(define (part2 port)
+  (define input (read-input port))
+  (define-values (h w) (apply values (array-dimensions input)))
+  (define mp (add-margin input))
+  (define areas (get-areas mp h w))
+  (get-discount-costs mp areas h w))
diff --git a/day13.scm b/day13.scm
new file mode 100644
index 0000000..4e13b46
--- /dev/null
+++ b/day13.scm
@@ -0,0 +1,4 @@
+(define-module (day13)
+	       #:use-module (ice-9 rdelim)
+	       #:use-module (ice-9 regex))
+