81 lines
1.9 KiB
Tcl
Executable File
81 lines
1.9 KiB
Tcl
Executable File
#!/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}]]
|