102 lines
2.9 KiB
Scheme
102 lines
2.9 KiB
Scheme
|
(import (rnrs))
|
||
|
|
|
||
|
|
(define-syntax curry
|
||
|
|
(syntax-rules ()
|
||
|
|
[(_ f x ...) (lambda (y) (f x ... y))]))
|
||
|
|
|
||
|
|
(define (mapmap f lst) (map (curry map f) lst))
|
||
|
|
|
||
|
|
(define (split-at ch str)
|
||
|
|
(let [(len (string-length str))]
|
||
|
|
(let loop [(start 0) (end 0) (acc '())]
|
||
|
|
(cond
|
||
|
|
[(>= start len)
|
||
|
|
(reverse (if (= start end) (cons "" acc) acc))]
|
||
|
|
[(>= 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 (trim str)
|
||
|
|
(let loop [(i 0)]
|
||
|
|
(if (char-whitespace? (string-ref str i))
|
||
|
|
(loop (+ i 1))
|
||
|
|
(let loop [(j (- (string-length str) 1))]
|
||
|
|
(if (char-whitespace? (string-ref str j))
|
||
|
|
(loop (- j 1))
|
||
|
|
(substring str i (+ j 1)))))))
|
||
|
|
|
||
|
|
(define (one-col str)
|
||
|
|
(let* [(str (trim str))
|
||
|
|
(words (split-at #\space str))]
|
||
|
|
(cons (string->symbol (cadr words)) (string->number (car words)))))
|
||
|
|
|
||
|
|
(define (split-line line)
|
||
|
|
(let* [(line (split-at #\: line))
|
||
|
|
(id (car line)) (line (cadr line))
|
||
|
|
(id (string->number (cadr (split-at #\space id))))
|
||
|
|
(draws (split-at #\; line))
|
||
|
|
(colours (map (curry split-at #\,) draws))
|
||
|
|
(pairs (mapmap one-col colours))]
|
||
|
|
(cons id pairs)))
|
||
|
|
|
||
|
|
(define (max-count col)
|
||
|
|
(case col [(red) 12] [(green) 13] [(blue) 14]))
|
||
|
|
|
||
|
|
|
||
|
|
(define-syntax case-list
|
||
|
|
(syntax-rules (nil cons)
|
||
|
|
[(_ lst [nil n ...] [(cons x xs) c ...])
|
||
|
|
(if (null? lst)
|
||
|
|
(begin n ...)
|
||
|
|
(let [(x (car lst)) (xs (cdr lst))] c ...))]
|
||
|
|
[(_ lst [(cons x xs) c ...] [nil n ...])
|
||
|
|
(case-list lst [nil n ...] [(cons x xs) c ...])]))
|
||
|
|
|
||
|
|
(define-syntax let-pair
|
||
|
|
(syntax-rules ()
|
||
|
|
[(_ [(x y) pair] body ...)
|
||
|
|
(let [(x (car pair)) (y (cdr pair))] body ...)]))
|
||
|
|
|
||
|
|
(define (valid-draw draws)
|
||
|
|
(case-list draws
|
||
|
|
[nil #t]
|
||
|
|
[(cons this rest)
|
||
|
|
(let-pair [(col count) this]
|
||
|
|
(if (<= count (max-count col)) (valid-draw rest) #f))]))
|
||
|
|
|
||
|
|
(define (valid line)
|
||
|
|
(let-pair [(id draws) line]
|
||
|
|
(if (for-all valid-draw draws) id #f)))
|
||
|
|
|
||
|
|
(define (read-file path)
|
||
|
|
(let* [(str (call-with-input-file path get-string-all))]
|
||
|
|
(map split-line
|
||
|
|
(filter (lambda (s) (not (string=? s "")))
|
||
|
|
(split-at #\newline str)))))
|
||
|
|
|
||
|
|
(define (total lines)
|
||
|
|
(apply + (map (lambda (line) (or (valid line) 0)) lines)))
|
||
|
|
|
||
|
|
(define input (read-file "in/day2"))
|
||
|
|
|
||
|
|
(define (part1) (total input))
|
||
|
|
|
||
|
|
(display (cons "part1" (part1))) (newline)
|
||
|
|
|
||
|
|
(define (min-cubes draws)
|
||
|
|
(fold-left
|
||
|
|
(lambda (a b)
|
||
|
|
(let* [(get (lambda (col draw) (cond [(assq col draw) => cdr] [else 0])))
|
||
|
|
(get-max (lambda (c) (cons c (max (get c a) (get c b)))))]
|
||
|
|
(list (get-max 'red) (get-max 'green) (get-max 'blue))))
|
||
|
|
'() draws))
|
||
|
|
|
||
|
|
(define (power line)
|
||
|
|
(fold-left (lambda (n c) (* n (cdr c))) 1 (min-cubes (cdr line))))
|
||
|
|
|
||
|
|
(define (part2) (apply + (map power input)))
|
||
|
|
|
||
|
|
(display (cons "part2" (part2))) (newline)
|