adventofcode2023/day20/sol.tcl

154 lines
3.9 KiB
Tcl
Executable File

#!/usr/bin/env tclsh
source ../prelude.tcl
proc read-input input {
global next
global type
global flip
global conj
global when
while {[gets $input line] >= 0} {
# oops
set line [replace $line ">" > "&" &]
#puts $line
must_regexp {^([%&]?)([a-z]+) -> (.*)$} $line _ sigil name to
set next($name) [replace $to "," ""]
if {$sigil eq ""} {
set type($name) ""
} elseif {$sigil eq "%"} {
set type($name) "flip"
set flip($name) 0
} elseif {$sigil eq "&"} {
set type($name) "conj"
set conj($name) [dict create]
set when($name) [dict create]
} else {
error "unknown sigil $sigil"
}
}
foreach n [array names type] {
foreach to $next($n) {
if {![info exists type($to)]} {
set type($to) ""
}
if {$type($to) eq "conj"} {
dict set conj($to) $n 0
dict set when($to) $n 0
}
}
}
}
proc pulse {init i {debug 0}} {
global next
global type
global flip
global conj
global count
global when
set n $init
set pulses {}
#puts [array get next]
incr count(0) ;# button
foreach to $next($init) {
#incr count(0)
lappend pulses $init $to 0
}
while {[llen $pulses]} {
if {$debug} {
puts "#[llen $pulses] : $pulses"
}
set copy $pulses
set pulses {}
foreach {from n value} $copy {
incr count($value)
if {$n eq "rx" && $value == 0} {
global solved
set solved 1
}
switch $type($n) {
flip {
if {$value == 0} {
set flip($n) [expr {!$flip($n)}]
foreach to $next($n) {
lappend pulses $n $to $flip($n)
}
}
}
conj {
dict set conj($n) $from $value
# remember the last time we saw a high bit from each input
if {$value} {
dict set when($n) $from $i
}
set all 1
foreach v [dict values $conj($n)] {
if {!$v} {
set all 0
break
}
}
set send [expr {!$all}]
foreach to $next($n) {
lappend pulses $n $to $send
}
}
}
}
}
#puts $count(0)
#puts $count(1)
}
proc solve input {
read-input $input
global count
#puts [array get next]
#array set count {0 0 1 0}
set count(0) 0
set count(1) 0
global when
for {set i 1} {$i <= 1000} {incr i} {
pulse broadcaster $i
}
puts "$count(0)"
puts $count(1)
puts [expr {$count(0) * $count(1)}]
global type
if {![info exists type(rx)]} return
set last $when(dn)
while {1} {
pulse broadcaster $i
if {$when(dn) ne $last} {
# rx is connected to a conj of 4 circuits
# which each emit 1 high pulse on a periodic cycle.
#
# this could be more difficult but it turns out
# that the step when the first output is produced
# is also equal to the cycle length,
# and all the cycles are a prime number so we don't
# even need to do an lcm
set a [lmul [dict values $when(dn)]]
if {$a != 0} {
puts $a
break
}
#puts $when(dn)
set last $when(dn)
}
incr i
}
}
solve stdin