adventofcode2023/day12/sol2.tcl

#!/usr/bin/env tclsh
source ../prelude.tcl
set input stdin

proc count-memo {row nums i left} {
    global memo
    if {$i == 0} {
        array unset memo
    }
    set key "$i,$left,[llength $nums]"
    if {[info exists memo($key)]} {
        #puts "$key exists"
        return $memo($key)
    }
    set n [count $row $nums $i $left]
    set memo($key) $n
    return $n
}

proc count {row nums i left} {
    #puts [list count $row $nums $i $left]
    if {$i >= [string length $row]} {
        return [expr {($left > 1 || [llength $nums] > 0) ? 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} {
            # contradiction: expecting a "#"
            return 0
        } elseif {$left == 1} {
            # left counts the number of "#" left in the current group,
            # plus the "." at the end. if left==1 then we've seen all
            # the "#" and now we need to see a "."
            set left 0
        } else {
            # nothing
        }
        return [count-memo $row $nums $i $left]
    }
    if {$c eq "#"} {
        if {$left > 1} {
            incr left -1
        } elseif {$left == 1} {
            # contradiction: expecting a "."
            return 0
        } else {
            set nums [lassign $nums left] ;# shift nums
        }
        return [count-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 [count-memo $row $nums $i $left]
        } elseif {$left == 1} {
            # must be "."
            set left 0
            #set row [string replace $row $i-1 $i-1 "."]
            return [count-memo $row $nums $i $left]
        } else {
            # bifurcate
            # "."
            #set row [string replace $row $i-1 $i-1 "."]
            set a [count-memo $row $nums $i $left]
            set nums [lassign $nums left]
            # "#"
            #set row [string replace $row $i-1 $i-1 "#"]
            set b [count-memo $row $nums $i $left]
            return [expr {$a + $b}]
        }
    }
    error "invalid character '$c' at position $i"
}

set part1 0
set part2 0
while {[gets $input line] >= 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]
    set n [count-memo $row $nums 0 0]
    puts "$n | $row $nums"
    incr part2 $n
}
puts $part2