aoc-2021/day10.rkt

#lang racket
(require "lib/common.rkt"
         data/either
         data/monad
         megaparsack
         megaparsack/text)

(define left-delim/p
  (char-in/p "([{<"))
(define (right-delim/p ch)
  (match ch
    [#\( (char/p #\))]
    [#\[ (char/p #\])]
    [#\{ (char/p #\})]
    [#\< (char/p #\>)]))

(define expr/p
  (do [x <- left-delim/p]
      (many/p expr/p)
      (right-delim/p x)))

(define (day10a lines)
  (define (score ch)
    (match ch
      [#\) 3]
      [#\] 57]
      [#\} 1197]
      [#\> 25137]
      [_ 0]))
  (for*/sum ([line (in-list lines)]
             [parsed (in-value (parse-string expr/p line))]
             #:when (failure? parsed))
    (score (message-unexpected (from-either parsed)))))

(define (day10b lines)
  (define incomplete-lines
    (for*/list ([line (in-list lines)]
                [parsed (in-value (parse-string expr/p line))]
                #:when (and (failure? parsed)
                            (equal? (message-unexpected (from-either parsed))
                                    "end of input")))
      line))

  (define (to-recover str)
    (define (get-recovery fail)
      (define msg (from-either fail))
      (for/first ([ch (in-list (message-expected msg))]
                  #:when (not (set-member? (set "'('" "'['" "'{'" "'<'") ch)))
        (string-ref ch 1)))

    (let loop ([recov ""])
      (define res (parse-string expr/p (string-append str recov)))
      (cond [(success? res) recov]
            [else (loop (string-append recov (string (get-recovery res))))])))

  (define (score recovery)
    (for/fold ([current-score 0])
              ([ch (in-string recovery)])
      (+ (* current-score 5)
         (match ch
           [#\) 1]
           [#\] 2]
           [#\} 3]
           [#\> 4]
           [_ 0]))))

  (define recoveries
    (for/vector ([line (in-list incomplete-lines)])
      (to-recover line)))

  (define (vector-middle vec)
    (vector-ref vec (floor (/ (vector-length vec) 2))))

  (vector-middle (vector-sort (vector-map score recoveries) <)))

(module+ main
  (call-with-input-file "data/day10.txt"
    (λ (prt)
      (define lines (port->lines prt))
      (answer 10 1 (day10a lines))
      (answer 10 2 (day10b lines)))))

(module+ test
  (require rackunit)

  (call-with-input-file "data/day10.test.txt"
    (λ (prt)
      (define lines (port->lines prt))
      (check-equal? (day10a lines) 26397))))