adventofcode2023/day08/sol.tcl

#!/usr/bin/env tclsh
source ../prelude.tcl

proc read-input {input} {
    set dirs [split [gets $input] ""] ;# LR...
    if {[gets $input] ne ""} { error "invalid input" }
    set graph {}
    while {[gets $input line] >= 0} {
        must_regexp {^([A-Z12]+) = \(([A-Z12]+), ([A-Z12]+)\)$} $line _ node left right
        lappend graph [list $node $left $right]
    }
    return [list $dirs $graph]
}

proc solve {dirs graph} {
    foreach x $graph {
        lassign $x node l r
        set G($node) [list $l $r]
    }
    if {![info exists G(ZZZ)]} { return }
    #puts [array get G]
    set node AAA
    set steps 0
    while {$node ne "ZZZ"} {
        set d [lindex $dirs [expr {$steps % [llength $dirs]}]]
        set node [lindex $G($node) [expr {($d eq "L") ? 0 : 1}]]
        puts "$d -> $node"
        incr steps
    }
    puts "$steps"
}

proc ghost-solve {dirs graph} {
    set start {}
    array set end {}
    foreach x $graph {
        lassign $x node l r
        set G($node) [list $l $r]
        if {[string match "*A" $node]} {
            lappend start $node
        }
        set end($node) [string match "*Z" $node]
    }
    puts "start: $node"
    set lengths {}
    foreach node $start {
        array set seen {}
        set node0 $node
        set path $node
        set steps 0
        # we make a couple simplifying assumptions:
        # first, that there is only one exit node on each cycle
        # and two, that the exits do not line up before the first cycle
        # 
        # find how long it takes to get to the exit the first time
        # then find the first cycle
        set initial -1
        set sanity -1
        set cycle {}
        while {1} {
            set i [expr {$steps % [llength $dirs]}]
            if {$end($node)} {
                if {$initial < 0} {
                    set initial $steps
                    set sanity $i
                } else {
                    set cycle $steps
                    if {$i != $sanity} { error "exit cycle desync" }
                    break
                }
            }
            set d [expr {[lindex $dirs $i] eq "L" ? 0 : 1}]
            set node [lindex $G($node) $d]
            #lappend path $node
            #puts "$d -> $node"
            incr steps
        }
        set len [expr {$cycle - $initial}]
        puts "$node0: found cycle of $len steps after $initial steps at node $node"
        # assumption #3: len == initial
        lappend lengths $len
    }

    # i'm too tired to code up a LCM function in tcl
    puts $lengths
    puts [exec python -c "import numpy; print(numpy.lcm.reduce(\[[join $lengths ","]\]))"]
    #puts "$steps"
}

set data [read-input stdin]
solve {*}$data
ghost-solve {*}$data