102 lines
2.5 KiB
Tcl
Executable File
102 lines
2.5 KiB
Tcl
Executable File
#!/usr/bin/env tclsh
|
|
source ../prelude.tcl
|
|
set input stdin
|
|
|
|
array set ::m {}
|
|
|
|
proc memo {row nums i left} {
|
|
set key "$i,$left,[llength $nums]"
|
|
if {[info exists ::m($key)]} {
|
|
#puts "$key exists"
|
|
#puts [array get ::m]
|
|
return $::m($key)
|
|
}
|
|
set n [count $row $nums $i $left]
|
|
set ::m($key) $n
|
|
return $n
|
|
}
|
|
|
|
proc count {row nums i left} {
|
|
#puts [list count $row $nums $i $left]
|
|
if {$i >= [string length $row]} {
|
|
if {[llength $nums] > 0} {
|
|
return 0
|
|
}
|
|
return [expr {$left > 1 ? 0 : 1}]
|
|
}
|
|
if {[llength $nums] <= 0 && $left <= 0} {
|
|
return [expr {[string first "#" $row $i] >= 0 ? 0 : 1}]
|
|
}
|
|
set c [string index $row $i]
|
|
incr i
|
|
if {$c eq "."} {
|
|
if {$left > 1} {
|
|
return 0
|
|
} elseif {$left == 1} {
|
|
set left 0
|
|
} else {
|
|
# nothing
|
|
}
|
|
return [memo $row $nums $i $left]
|
|
}
|
|
if {$c eq "#"} {
|
|
if {$left > 1} {
|
|
incr left -1
|
|
} elseif {$left == 1} {
|
|
return 0
|
|
} else {
|
|
set nums [lassign $nums left] ;# shift nums
|
|
}
|
|
return [memo $row $nums $i $left]
|
|
}
|
|
if {$c eq "?"} {
|
|
if {$left > 1} {
|
|
# must be "#"
|
|
incr left -1
|
|
#set row [string replace $row $i-1 $i-1 "#"]
|
|
return [memo $row $nums $i $left]
|
|
} elseif {$left == 1} {
|
|
# must be "."
|
|
set left 0
|
|
#set row [string replace $row $i-1 $i-1 "."]
|
|
return [memo $row $nums $i $left]
|
|
} else {
|
|
# bifurcate
|
|
#set row [string replace $row $i-1 $i-1 "."]
|
|
set a [memo $row $nums $i $left] ;# "."
|
|
set nums [lassign $nums left]
|
|
#set row [string replace $row $i-1 $i-1 "#"]
|
|
set b [memo $row $nums $i $left] ;# "#"
|
|
return [expr {$a + $b}]
|
|
}
|
|
}
|
|
error "invalid character '$c' at position $i"
|
|
}
|
|
|
|
proc match {row nums} {
|
|
#puts -nonewline " $row -> "
|
|
set row [string map {. " "} $row]
|
|
#puts " $row"
|
|
foreach group $row n $nums {
|
|
if {[string length $group] != $n} {
|
|
return 0
|
|
}
|
|
}
|
|
return 1
|
|
}
|
|
|
|
set part2 0
|
|
while {[gets $input line] >= 0} {
|
|
set n 0
|
|
lassign $line row nums
|
|
set row "$row?$row?$row?$row?$row"
|
|
set row [string trim $row "."]
|
|
set nums [split $nums ","]
|
|
set nums [concat $nums $nums $nums $nums $nums]
|
|
array unset ::m
|
|
set n [memo $row $nums 0 0]
|
|
puts "$n | $row $nums"
|
|
incr part2 $n
|
|
}
|
|
puts $part2
|