84 lines
3.2 KiB
Scheme
84 lines
3.2 KiB
Scheme
(import (chicken string)
|
|
(chicken irregex))
|
|
|
|
(define input "
|
|
Time: 58 81 96 76
|
|
Distance: 434 1041 2219 1218")
|
|
|
|
(define-record race time-limit record-distance winning-distances losing-distances)
|
|
|
|
(define input-extraction-irregex
|
|
'(: "Time:"
|
|
(submatch-named time-vals (+ (or numeric whitespace)))
|
|
"Distance:"
|
|
(submatch-named distance-vals (+ (or numeric whitespace)))))
|
|
|
|
(define (input->race-records input)
|
|
(let ((match (irregex-search input-extraction-irregex
|
|
input)))
|
|
(map (lambda (time distance)
|
|
(make-race time distance #f #f))
|
|
(map string->number (string-split (irregex-match-substring match 'time-vals)))
|
|
(map string->number (string-split (irregex-match-substring match 'distance-vals))))))
|
|
|
|
(define (get-distance race hold-time)
|
|
(let ((time-remaining (- (race-time-limit race) hold-time)))
|
|
(* time-remaining hold-time)))
|
|
|
|
(define (calc-race-distances race
|
|
#!optional (hold-time 1) (winning-distances '()) (losing-distances '()))
|
|
(let* ((record-distance (race-record-distance race))
|
|
(new-distance (get-distance race hold-time))
|
|
(is-new-record? (> new-distance record-distance)))
|
|
(cond
|
|
((= new-distance 0)
|
|
(begin
|
|
(race-winning-distances-set! race winning-distances)
|
|
(race-losing-distances-set! race losing-distances)
|
|
race))
|
|
(else
|
|
(calc-race-distances
|
|
race (+ hold-time 1)
|
|
(if is-new-record? (cons new-distance winning-distances) winning-distances)
|
|
(if is-new-record? losing-distances (cons new-distance losing-distances)))))))
|
|
|
|
(define (calc-part-1)
|
|
(foldl *
|
|
1 (map (compose length race-winning-distances)
|
|
(map calc-race-distances (input->race-records input)))))
|
|
|
|
(define (input->race-record input)
|
|
(let* ((match (irregex-search input-extraction-irregex input))
|
|
(time-val ((compose string->number
|
|
(cut foldl string-append "" <>)
|
|
string-split
|
|
(cut irregex-match-substring <> 'time-vals))
|
|
match))
|
|
(distance-val ((compose string->number
|
|
(cut foldl string-append "" <>)
|
|
string-split
|
|
(cut irregex-match-substring <> 'distance-vals))
|
|
match)))
|
|
(make-race time-val distance-val #f #f)))
|
|
|
|
(define (calc-race-distances-with-counter race
|
|
#!optional (hold-time 1) (winning-distances 0) (losing-distances 0))
|
|
(let* ((record-distance (race-record-distance race))
|
|
(new-distance (get-distance race hold-time))
|
|
(is-new-record? (> new-distance record-distance)))
|
|
(cond
|
|
((= new-distance 0)
|
|
(begin
|
|
(race-winning-distances-set! race winning-distances)
|
|
(race-losing-distances-set! race losing-distances)
|
|
race))
|
|
(else
|
|
(calc-race-distances-with-counter
|
|
race (+ hold-time 1)
|
|
(if is-new-record? (+ 1 winning-distances) winning-distances)
|
|
(if is-new-record? losing-distances (+ 1 losing-distances)))))))
|
|
|
|
(define (calc-part-2)
|
|
(race-winning-distances
|
|
(calc-race-distances-with-counter (input->race-record input))))
|