108 lines
3.4 KiB
Scheme
108 lines
3.4 KiB
Scheme
(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)
|