(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)))) ; Sort chars in string according to `proc' (define (string-sort proc str) (list->string (list-sort proc (string->list str)))) ; Partially applied equality check (define (check-identical? word1) (lambda (word2) (equal? word1 word2))) ; Partially applied anagram check (define (check-anagram? word1) (lambda (word2) ; Sort chars by Unicode value, then check string equality (string=? (string-sort char (count (proc (car words)) phrase) 1) #f (loop (cdr words)))))) (map string-split lines))) (define (solve-part1 lines) (solve-puzzle check-identical? lines)) (define (solve-part2 lines) (solve-puzzle check-anagram? lines)) )