solve day 13 part 2

1 files changed, 69 insertions, 0 deletions

diff --git a/13/2.rkt b/13/2.rkt
new file mode 100644
index 0000000..14fac6b
--- /dev/null
+++ b/13/2.rkt
@@ -0,0 +1,69 @@
+#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))