magical
/
adventofcode2023
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

day 12 cleanup

main
magical 2023-12-12 09:40:29 +00:00
parent 99405e2ad0
commit c55423d6f3
1 changed files with 26 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
day12/sol2.tcl
View File

@ -2,27 +2,25 @@
source ../prelude.tcl source ../prelude.tcl
set input stdin set input stdin
array set ::m {} proc count-memo {row nums i left} {
global memo
proc memo {row nums i left} { if {$i == 0} {
array unset memo
}
set key "$i,$left,[llength $nums]" set key "$i,$left,[llength $nums]"
if {[info exists ::m($key)]} { if {[info exists memo($key)]} {
#puts "$key exists" #puts "$key exists"
#puts [array get ::m] return $memo($key)
return $::m($key)
} }
set n [count $row $nums $i $left] set n [count $row $nums $i $left]
set ::m($key) $n set memo($key) $n
return $n return $n
} }
proc count {row nums i left} { proc count {row nums i left} {
#puts [list count $row $nums $i $left] #puts [list count $row $nums $i $left]
if {$i >= [string length $row]} { if {$i >= [string length $row]} {
if {[llength $nums] > 0} { return [expr {($left > 1 || [llength $nums] > 0) ? 0 : 1}]
return 0
}
return [expr {$left > 1 ? 0 : 1}]
} }
if {[llength $nums] <= 0 && $left <= 0} { if {[llength $nums] <= 0 && $left <= 0} {
return [expr {[string first "#" $row $i] >= 0 ? 0 : 1}] return [expr {[string first "#" $row $i] >= 0 ? 0 : 1}]
@ -31,70 +29,64 @@ proc count {row nums i left} {
incr i incr i
if {$c eq "."} { if {$c eq "."} {
if {$left > 1} { if {$left > 1} {
# contradiction: expecting a "#"
return 0 return 0
} elseif {$left == 1} { } 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 set left 0
} else { } else {
# nothing # nothing
} }
return [memo $row $nums $i $left] return [count-memo $row $nums $i $left]
} }
if {$c eq "#"} { if {$c eq "#"} {
if {$left > 1} { if {$left > 1} {
incr left -1 incr left -1
} elseif {$left == 1} { } elseif {$left == 1} {
# contradiction: expecting a "."
return 0 return 0
} else { } else {
set nums [lassign $nums left] ;# shift nums set nums [lassign $nums left] ;# shift nums
} }
return [memo $row $nums $i $left] return [count-memo $row $nums $i $left]
} }
if {$c eq "?"} { if {$c eq "?"} {
if {$left > 1} { if {$left > 1} {
# must be "#" # must be "#"
incr left -1 incr left -1
#set row [string replace $row $i-1 $i-1 "#"] #set row [string replace $row $i-1 $i-1 "#"]
return [memo $row $nums $i $left] return [count-memo $row $nums $i $left]
} elseif {$left == 1} { } elseif {$left == 1} {
# must be "." # must be "."
set left 0 set left 0
#set row [string replace $row $i-1 $i-1 "."] #set row [string replace $row $i-1 $i-1 "."]
return [memo $row $nums $i $left] return [count-memo $row $nums $i $left]
} else { } else {
# bifurcate # bifurcate
# "."
#set row [string replace $row $i-1 $i-1 "."] #set row [string replace $row $i-1 $i-1 "."]
set a [memo $row $nums $i $left] ;# "." set a [count-memo $row $nums $i $left]
set nums [lassign $nums left] set nums [lassign $nums left]
# "#"
#set row [string replace $row $i-1 $i-1 "#"] #set row [string replace $row $i-1 $i-1 "#"]
set b [memo $row $nums $i $left] ;# "#" set b [count-memo $row $nums $i $left]
return [expr {$a + $b}] return [expr {$a + $b}]
} }
} }
error "invalid character '$c' at position $i" error "invalid character '$c' at position $i"
} }
proc match {row nums} { set part1 0
#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 set part2 0
while {[gets $input line] >= 0} { while {[gets $input line] >= 0} {
set n 0
lassign $line row nums lassign $line row nums
set row "$row?$row?$row?$row?$row" set row "$row?$row?$row?$row?$row"
set row [string trim $row "."] #set row [string trim $row "."]
set nums [split $nums ","] set nums [split $nums ","]
set nums [concat $nums $nums $nums $nums $nums] set nums [concat $nums $nums $nums $nums $nums]
array unset ::m set n [count-memo $row $nums 0 0]
set n [memo $row $nums 0 0]
puts "$n | $row $nums" puts "$n | $row $nums"
incr part2 $n incr part2 $n
} }