summaryrefslogtreecommitdiff
path: root/02/lib.scm
diff options
context:
space:
mode:
authorPrefetch2024-03-02 19:36:12 +0100
committerPrefetch2024-03-02 19:36:12 +0100
commit1fbb07c54523c7a576bfff1cb689e155dd55f15a (patch)
tree7aa9f92a7d99ae9203b538803b7efefd846b67e0 /02/lib.scm
parentaf589b238c1d51960d8af3b36041aca2bad7855b (diff)
Add first five days
Diffstat (limited to '02/lib.scm')
-rw-r--r--02/lib.scm74
1 files changed, 74 insertions, 0 deletions
diff --git a/02/lib.scm b/02/lib.scm
new file mode 100644
index 0000000..0274dad
--- /dev/null
+++ b/02/lib.scm
@@ -0,0 +1,74 @@
+(library (lib)
+ (export solve-part1 solve-part2)
+ (import (chezscheme))
+
+ ; Split list at first delimiter into `prefix' and `suffix'
+ ; Return value is a pair like `((p r e f i x) s u f f i x)'
+ (define (list-split-left delimiter? xs)
+ (let loop ((prefix '())
+ (suffix xs))
+ (if (null? suffix)
+ (cons prefix suffix)
+ (let ((x (car suffix)))
+ (if (delimiter? x)
+ ; Found first delimiter, so return immediately
+ (cons prefix (cdr suffix))
+ ; `x' isn't a delimiter, so append it to `prefix'
+ (loop (append prefix (list x)) (cdr suffix)))))))
+
+ ; Split list at given delimiter into list of sublists
+ (define (list-split delimiter? xs)
+ (let loop ((pieces '())
+ (rest xs))
+ (if (null? rest)
+ ; Fix order and remove all empty sublists from output
+ ; (which are caused by consecutive delimiters in `xs')
+ (reverse (remp null? pieces))
+ ; Extract next piece from `rest' and prepend it to `pieces'
+ (let ((next (list-split-left delimiter? rest)))
+ (loop (cons (car next) pieces) (cdr next))))))
+
+ ; Split string at whitespace into list of words
+ (define (string-split str)
+ (map list->string (list-split char-whitespace? (string->list str))))
+
+ ; Partially applied divisibility check
+ (define (check-divisor? x)
+ (lambda (y)
+ (and (not (= y 0)) ; Don't try dividing by zero
+ (not (= x y)) ; Disallow trivial solution
+ (= (mod x y) 0))))
+
+ ; Find minimum and maximum in row, return difference
+ (define (find-range row)
+ (- (apply max row) (apply min row)))
+
+ ; Find `x' and `y' where `y' is divisor of `x', return quotient
+ (define (find-quotient row)
+ ; Note: we don't check if we've reached the end of `xs',
+ ; because we're guaranteed success before that happens.
+ ; We're also guaranteed only one non-trivial solution.
+ (let loop ((xs row))
+ (let* ((x (car xs))
+ (y (find (check-divisor? x) row)))
+ ; Is this the (`x',`y') combination we're looking for,
+ ; i.e. have we found a valid divisor `y' for this `x'?
+ (if y
+ (div x y)
+ (loop (cdr xs))))))
+
+ ; Add up result of `proc' for each `row' of numbers in `lines'
+ (define (solve-puzzle proc lines)
+ (fold-left
+ (lambda (accum row)
+ (+ accum (proc (map string->number row))))
+ 0
+ (map string-split lines)))
+
+ (define (solve-part1 lines)
+ (solve-puzzle find-range lines))
+
+ (define (solve-part2 lines)
+ (solve-puzzle find-quotient lines))
+
+)