adventofcode2023/day20/sol.tcl

#!/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