(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)) )