diff options
| -rw-r--r-- | day08.scm | 122 | ||||
| -rw-r--r-- | day09.scm | 88 | ||||
| -rw-r--r-- | day10.scm | 67 | ||||
| -rw-r--r-- | day11.scm | 72 | ||||
| -rw-r--r-- | day12.scm | 115 | ||||
| -rw-r--r-- | day13.scm | 4 |
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)) + |