day 12 solution

day12/sample1.in

@@ -0,0 +1,6 @@
+#.#.### 1,1,3
+.#...#....###. 1,1,3
+.#.###.#.###### 1,3,1,6
+####.#...#... 4,1,1
+#....######..#####. 1,6,5
+.###.##....# 3,2,1

day12/sample2.in

@@ -0,0 +1,6 @@
+???.### 1,1,3
+.??..??...?##. 1,1,3
+?#?#?#?#?#?#?#? 1,3,1,6
+????.#...#... 4,1,1
+????.######..#####. 1,6,5
+?###???????? 3,2,1

day12/sol.tcl

@@ -0,0 +1,42 @@
+#!/usr/bin/env tclsh
+source ../prelude.tcl
+set input stdin
+
+proc expand {row {start 0}} {
+    set i [string first {?} $row $start]
+    if {$i < 0} {
+        return [list $row]
+    }
+    set a [string replace $row $i $i "."]
+    set b [string replace $row $i $i "#"]
+    incr i
+    return [concat [expand $a $i] [expand $b $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 part1 0
+while {[gets $input line] >= 0} {
+    set n 0
+    lassign $line row nums
+    set nums [split $nums ","]
+    foreach x [expand $row] {
+        #puts $x
+        if {[match $x $nums]} {
+            incr n
+        }
+    }
+    puts "$n | $row $nums"
+    incr part1 $n
+}
+puts $part1

day12/sol2.tcl

@@ -0,0 +1,101 @@
+#!/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