(import (rnrs) (only (chezscheme) define-values)) (define-syntax curry (syntax-rules () [(_ f x ...) (lambda (y) (f x ... y))])) (define (mapmap f lst) (map (curry map f) lst)) (define-syntax let-pair (syntax-rules () [(_ [(x y) pair] . body) (let* [(xpair pair) (x (car xpair)) (y (cdr xpair))] . body)])) (define-syntax case-list (syntax-rules (nil cons) [(_ lst [nil . nbody] [(cons x xs) . cbody]) (let [(xlst lst)] (if (null? xlst) (begin . nbody) (let-pair [(x xs) xlst] . cbody)))] [(_ lst [(cons x xs) . cbody] [nil . nbody]) (case-list lst [nil . nbody] [(cons x xs) . cbody])])) (define-syntax split-list (syntax-rules () [(_ names lst) (define-values names (apply values lst))])) (define sum (curry apply +)) (define product (curry apply *)) (define concat (curry apply append)) (define (split-at ch str) (define len (string-length str)) (let loop [(start 0) (end 0) (acc '())] (cond [(>= end len) (reverse (cons (substring str start len) acc))] [(char=? ch (string-ref str end)) (loop (+ end 1) (+ end 1) (cons (substring str start end) acc))] [else (loop start (+ end 1) acc)]))) (define (split-at-nested chs0 str) (define chs (cond [(list? chs0) chs0] [(string? chs0) (string->list chs0)])) (case-list chs [nil str] [(cons ch chs) (map (curry split-at-nested chs) (split-at ch str))])) (define (trim-by p str) (define (ok k) (not (p (string-ref str k)))) (define i (do [(i 0 (+ i 1))] [(ok i) i])) (define j (do [(j (string-length str) (- j 1))] [(ok (- j 1)) j])) (substring str i j)) (define trim (curry trim-by char-whitespace?)) (define (one-col str) (split-list (count col) (split-at #\space (trim str))) (cons (string->symbol col) (string->number count))) (define (split-line line0) (split-list (id-str line) (split-at #\: line0)) (define id (string->number (cadr (split-at #\space id-str)))) (define pairs (mapmap one-col (split-at-nested ";," line))) (cons id pairs)) (define (maybe-split-line line) (and (not (string=? line "")) (split-line line))) (define max-counts '((red . 12) (green . 13) (blue . 14))) (define (max-count col) (cond [(assq col max-counts) => cdr] [else 0])) (define (valid-draw draws) (define (ok p) (let-pair [(col n) p] (<= n (max-count col)))) (for-all ok draws)) (define (valid line) (let-pair [(id draws) line] (and (for-all valid-draw draws) id))) (define (map-filter p lst) (define (one x ys) (let [(y (p x))] (if y (cons y ys) ys))) (fold-right one '() lst)) (define (read-file path) (map-filter maybe-split-line (split-at #\newline (call-with-input-file path get-string-all)))) (define (total lines) (sum (map (lambda (line) (or (valid line) 0)) lines))) (define input (read-file "in/day2")) (define (part1) (total input)) (display (cons "part1" (part1))) (newline) (define (get-col col draw) (cond [(assq col draw) => cdr] [else 0])) (define (get-max draw1 draw2 col) (cons col (max (get-col col draw1) (get-col col draw2)))) (define (combine draw1 draw2) (define (get-max-of col) (get-max draw1 draw2 col)) (list (get-max-of 'red) (get-max-of 'green) (get-max-of 'blue))) (define (min-cubes draws) (fold-left combine '() draws)) (define (power line) (product (map cdr (min-cubes (cdr line))))) (define (part2) (sum (map power input))) (display (cons "part2" (part2))) (newline)