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]
    }
    set node $start
    set steps 0
    puts "start: $node"
    while {1} {
        set done 1
        foreach n $node {
            if {! $end($n)} {
                set done 0
                break
            }
        }
        if {$done} break

        set d [lindex $dirs [expr {$steps % [llength $dirs]}]]
        set i [expr {$d eq "L" ? 0 : 1}]
        set node [lmap n $node {lindex $G($n) $i}]
        #puts "$d -> $node"
        incr steps
    }
    puts "$steps"
}

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