add more helpers

llen and slen to get the length of a list or string.
trim, replace and splitstr for common string operations.

day13/sample1.in

@@ -0,0 +1,15 @@
+#.##..##.
+..#.##.#.
+##......#
+##......#
+..#.##.#.
+..##..##.
+#.#.##.#.
+
+#...##..#
+#....#..#
+..##..###
+#####.##.
+#####.##.
+..##..###
+#....#..#

day13/sol.tcl

@@ -0,0 +1,80 @@
+#!/usr/bin/env tclsh
+source ../prelude.tcl
+
+set input stdin
+set patterns [splitstr [trim [read $input]] "\n\n"]
+set patterns [lmap p $patterns {split $p "\n"}]
+puts "$patterns"
+
+proc reflect pattern {
+    set total 0
+    foreach pat [list $pattern [transpose $pattern]] factor {100 1} {
+        #puts "reflect $pat"
+        for {set i 1} {$i < [llen $pat]} {incr i} {
+            set ok 1
+            for {set j 0} {$i + $j < [llen $pat] && $i-$j-1 >= 0} {incr j} {
+                if {[lindex $pat $i+$j] ne [lindex $pat [expr {$i-$j-1}]]} {
+                    set ok 0
+                    break
+                }
+            }
+            if {$ok} {
+                #puts "$i $factor"
+                incr total [expr {$i * $factor}]
+            }
+        }
+    }
+    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 < [llen $pat]} {incr i} {
+            set diff 0
+            for {set j 0} {$i + $j < [llen $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 {
+        lappend c [string index $row $i]
+    }
+    return [join $c ""]
+}
+
+proc transpose pat {
+    set C [slen [lindex $pat 0]]
+    set out {}
+    for {set i 0} {$i < $C} {incr i} {
+        lappend out [column $pat $i]
+    }
+    return $out
+}
+
+foreach pat $patterns {
+    puts "[fix $pat] <| $pat"
+}
+
+puts [ladd [lmap pat $patterns {reflect $pat}]]
+puts [ladd [lmap pat $patterns {fix $pat}]]

prelude.tcl

@@ -4,6 +4,11 @@ namespace import tcl::mathfunc::max
 
 proc {#} args {}
 
+proc llen {lst} { return [llength $lst] }
+proc slen {str} { return [string length $str] }
+proc trim args { return [uplevel [concat string trim $args]] }
+proc replace {str a b} { return [string map [list $a $b] $str] }
+
 proc ladd {list} {
     set t 0
     foreach x $list { incr t $x }
@@ -16,6 +21,12 @@ proc lmul {list} {
     return $p
 }
 
+# split s on a substring
+proc splitstr {s sep} {
+    # replace $sep with ascii char 30, aka "record separator"
+    return [split [replace $s $sep "\x1E"] "\x1E"]
+}
+
 proc must_regexp args {
     if {! [uplevel [concat regexp $args]]} {
         error "regexp failed"