adventofcode2023/day19/sol.tcl

147 lines
4.8 KiB
Tcl
Executable File

#!/usr/bin/env tclsh
source ../prelude.tcl
proc read-workflows input {
set flows [dict create]
while {[gets $input line] >= 0} {
if {$line eq ""} break
set line [string map [list \{ @ \} @] $line]
must_regexp {([a-z]+)@([^@]*)@} $line _ name rulestr
set rules {}
foreach r [split $rulestr ","] {
if {[string first : $r] >= 0} {
lassign [split $r :] cond dest
set cond [regsub -all {([xmas])} $cond {$\1}]
lappend rules $cond $dest
} else {
lappend rules default $r
}
}
dict set flows $name $rules
}
return $flows
}
proc read-values input {
set values {}
while {[gets $input line] >= 0} {
set line [trim [regsub -all {[^a-z0-9]} $line { }]]
lappend values [dict create {*}[split $line]]
}
return $values
}
proc filter {flows value} {
set f in
while {[dict exists $flows $f]} {
set rules [dict get $flows $f]
foreach {cond dest} $rules {
if {$cond eq "default" || [dict with value {expr $cond}]} {
set f $dest
break
}
}
}
return $f
}
proc filter-all flows {
lappend state(in) [dict create x {1 4000} m {1 4000} a {1 4000} s {1 4000}]
#set state(in) {
# {x {787 787} m {2655 2655} a {1222 1222} s {2876 2876}}
# {x {1679 1679} m {44 44} a {2067 2067} s {496 496}}
# {x {2036 2036} m {264 264} a {79 79} s {2244 2244}}
# {x {2461 2461} m {1339 1339} a {466 466} s {291 291}}
# {x {2127 2127} m {1623 1623} a {2188 2188} s {1013 1013}}
#}
set flows [dict create {*}[replace $flows "$" ""]]
#puts $flows
set done 0
while {!$done} {
#puts [array get state]
# break if everything is in the accept or reject state
set done 1
foreach {f ranges} [array get state] {
if {$f eq "A" || $f eq "R"} continue
set done 0
unset state($f)
foreach range $ranges {
set rules [dict get $flows $f]
foreach {cond dest} $rules {
if {$cond eq "default"} {
lappend state($dest) $range
break
}
if {[string first < $cond] >= 0} {
lassign [split $cond <] var cutoff
lassign [dict get $range $var] min max
if {$cutoff > $max} {
# entire range already lower than required
lappend state($dest) $range
break
}
if {$min >= $cutoff} {
# entire range above required value
continue
}
# split range
lappend state($dest) [dict replace $range $var [list $min [expr {$cutoff-1}]]]
dict set range $var [list $cutoff $max]
continue
}
if {[string first > $cond] >= 0} {
lassign [split $cond >] var cutoff
lassign [dict get $range $var] min max
if {$cutoff < $min} {
# entire range already greater than required
lappend state($dest) $range
break
}
if {$max <= $cutoff} {
# entire range below required value
continue
}
# split range
lappend state($dest) [dict replace $range $var [list [expr {$cutoff+1}] $max]]
dict set range $var [list $min $cutoff]
continue
}
error "unhandled rule $cond:$dest"
}
}
}
}
return $state(A)
}
proc solve input {
set flows [read-workflows $input]
set values [read-values $input]
#puts $flows
puts $values
# part 1
foreach v $values {
set f [filter $flows $v]
set score [ladd [lextract $v 2 1]]
puts "$v : $f : $score"
if {$f eq "A"} { incr part1 $score }
}
puts "part 1 = $part1"
# part 2
foreach r [filter-all $flows] {
set combos [lmul [lmap {min max} [join [dict values $r]] {
if {$min > $max} {
error "invalid range: $min $max"
}
expr {$max - $min + 1}
}]]
incr part2 $combos
puts "A: $r = $combos"
}
puts "part 2 = $part2"
}
solve stdin