day 13 part 2

day13/sol.tcl

@@ -2,16 +2,9 @@
 source ../prelude.tcl
 
 set input stdin
-set patterns [read $input]
-set patterns [string trim $patterns]
-#puts "$patterns"
-set patterns [string map {"\n\n" "|"} $patterns]
-#puts "$patterns"
-set patterns [split $patterns "|"]
-#puts "$patterns"
+set patterns [split [string map {"\n\n" "|"} [string trim [read $input]]] "|"]
 set patterns [lmap p $patterns {split $p "\n"}]
 puts "$patterns"
-#puts "$patterns"
 
 proc reflect pattern {
     set total 0
@@ -34,6 +27,34 @@ proc reflect pattern {
     return $total
 }
 
+proc fix pattern {
+    set total 0
+    foreach pat [list $pattern [transpose $pattern]] factor {100 1} {
+        #puts "reflect $pat"
+        array unset smudges
+        for {set i 1} {$i < [llength $pat]} {incr i} {
+            set diff 0
+            for {set j 0} {$i + $j < [llength $pat] && $i-$j-1 >= 0} {incr j} {
+                incr diff [distance [lindex $pat $i+$j] [lindex $pat [expr {$i-$j-1}]]]
+                if {$diff > 1} break
+            }
+            if {$diff == 1} {
+                #puts "$i $factor"
+                incr total [expr {$i * $factor}]
+            }
+        }
+    }
+    return $total
+}
+
+proc distance {a b} {
+    set d 0
+    foreach x [split $a ""] y [split $b ""] {
+        incr d [expr {$x ne $y}]
+    }
+    return $d
+}
+
 proc column {lst i} {
     set c {}
     foreach row $lst {
@@ -52,7 +73,8 @@ proc transpose pat {
 }
 
 foreach pat $patterns {
-    puts "[reflect $pat] <| $pat"
+    puts "[fix $pat] <| $pat"
 }
 
 puts [ladd [lmap pat $patterns {reflect $pat}]]
+puts [ladd [lmap pat $patterns {fix $pat}]]