add more helpers
llen and slen to get the length of a list or string. trim, replace and splitstr for common string operations.main
parent
b99ad03de5
commit
632022d073
|
@ -2,7 +2,7 @@
|
||||||
source ../prelude.tcl
|
source ../prelude.tcl
|
||||||
|
|
||||||
set input stdin
|
set input stdin
|
||||||
set patterns [split [string map {"\n\n" "|"} [string trim [read $input]]] "|"]
|
set patterns [splitstr [trim [read $input]] "\n\n"]
|
||||||
set patterns [lmap p $patterns {split $p "\n"}]
|
set patterns [lmap p $patterns {split $p "\n"}]
|
||||||
puts "$patterns"
|
puts "$patterns"
|
||||||
|
|
||||||
|
@ -10,9 +10,9 @@ proc reflect pattern {
|
||||||
set total 0
|
set total 0
|
||||||
foreach pat [list $pattern [transpose $pattern]] factor {100 1} {
|
foreach pat [list $pattern [transpose $pattern]] factor {100 1} {
|
||||||
#puts "reflect $pat"
|
#puts "reflect $pat"
|
||||||
for {set i 1} {$i < [llength $pat]} {incr i} {
|
for {set i 1} {$i < [llen $pat]} {incr i} {
|
||||||
set ok 1
|
set ok 1
|
||||||
for {set j 0} {$i + $j < [llength $pat] && $i-$j-1 >= 0} {incr j} {
|
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}]]} {
|
if {[lindex $pat $i+$j] ne [lindex $pat [expr {$i-$j-1}]]} {
|
||||||
set ok 0
|
set ok 0
|
||||||
break
|
break
|
||||||
|
@ -32,9 +32,9 @@ proc fix pattern {
|
||||||
foreach pat [list $pattern [transpose $pattern]] factor {100 1} {
|
foreach pat [list $pattern [transpose $pattern]] factor {100 1} {
|
||||||
#puts "reflect $pat"
|
#puts "reflect $pat"
|
||||||
array unset smudges
|
array unset smudges
|
||||||
for {set i 1} {$i < [llength $pat]} {incr i} {
|
for {set i 1} {$i < [llen $pat]} {incr i} {
|
||||||
set diff 0
|
set diff 0
|
||||||
for {set j 0} {$i + $j < [llength $pat] && $i-$j-1 >= 0} {incr j} {
|
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}]]]
|
incr diff [distance [lindex $pat $i+$j] [lindex $pat [expr {$i-$j-1}]]]
|
||||||
if {$diff > 1} break
|
if {$diff > 1} break
|
||||||
}
|
}
|
||||||
|
@ -64,7 +64,7 @@ proc column {lst i} {
|
||||||
}
|
}
|
||||||
|
|
||||||
proc transpose pat {
|
proc transpose pat {
|
||||||
set C [string length [lindex $pat 0]]
|
set C [slen [lindex $pat 0]]
|
||||||
set out {}
|
set out {}
|
||||||
for {set i 0} {$i < $C} {incr i} {
|
for {set i 0} {$i < $C} {incr i} {
|
||||||
lappend out [column $pat $i]
|
lappend out [column $pat $i]
|
||||||
|
|
11
prelude.tcl
11
prelude.tcl
|
@ -4,6 +4,11 @@ namespace import tcl::mathfunc::max
|
||||||
|
|
||||||
proc {#} args {}
|
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} {
|
proc ladd {list} {
|
||||||
set t 0
|
set t 0
|
||||||
foreach x $list { incr t $x }
|
foreach x $list { incr t $x }
|
||||||
|
@ -16,6 +21,12 @@ proc lmul {list} {
|
||||||
return $p
|
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 {
|
proc must_regexp args {
|
||||||
if {! [uplevel [concat regexp $args]]} {
|
if {! [uplevel [concat regexp $args]]} {
|
||||||
error "regexp failed"
|
error "regexp failed"
|
||||||
|
|
Loading…
Reference in New Issue