| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869 |
- #lang racket
- (require "../lib/utils.rkt")
- (define lines
- (call-with-input-file "input"
- (λ (fp) (get-lines fp))))
- (define patterns (split-list-by "" lines))
- (define (fix-smudge pattern x y)
- (define new-pattern (map string-copy pattern))
- (define pattern-vec (list->vector new-pattern))
- (define c (string-ref (vector-ref pattern-vec y) x))
- (case c
- ((#\#) (string-set! (vector-ref pattern-vec y) x #\.))
- ((#\.) (string-set! (vector-ref pattern-vec y) x #\#)))
- (vector->list pattern-vec))
- (define (find-reflection lines)
- (define lines-vec (list->vector lines))
- (define len (vector-length lines-vec))
- (define (find-first)
- (let loop ((i 0) (ret '()))
- (if (>= i (- len 1))
- (reverse ret)
- (if (string=? (vector-ref lines-vec i)
- (vector-ref lines-vec (+ i 1)))
- (loop (+ 1 i) (cons i ret))
- (loop (+ 1 i) ret)))))
- (define (count start)
- (let loop ((cnt 1) (i start))
- (if (or (< i 0)
- (>= (+ start cnt) len))
- (+ start 1)
- (if (string=? (vector-ref lines-vec i)
- (vector-ref lines-vec (+ start cnt)))
- (loop (+ 1 cnt) (- i 1))
- 0))))
- (define start (find-first))
- (if (null? start)
- '()
- (filter (λ (x) (not (= 0 x)))
- (map count start))))
- (define (score pattern)
- (define h-score (map (λ (x) (* 100 x))(find-reflection pattern)))
- (define w-score (find-reflection (transpose-list pattern)))
- (filter (λ (x) (not (= 0 x)))
- (append h-score w-score)))
- (define (fixed-score pattern)
- (define original-score (car (score pattern)))
- (define w (string-length (car pattern)))
- (define h (length pattern))
- (let loop ((x 0) (y 0))
- (if (>= y h)
- 0
- (if (>= x w)
- (loop 0 (+ 1 y))
- (let ()
- (define s (score (fix-smudge pattern x y)))
- (define result (filter (λ (x) (not (= original-score x)))
- s))
- (if (null? result)
- (loop (+ 1 x) y)
- (car result)))))))
- (apply + (map fixed-score patterns))
|
