adventofcode2023/day16/sol.tcl

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

proc read-input {input} {
    global grid
    global width
    global height
    set i 0
    while {[gets $input line] >= 0} {
        set j 0
        foreach c [split $line ""] {
            set grid($i,$j) $c
            incr j
        }
        incr i
    }
    set height $i
    set width $j
}

proc reset-visited {} {
    global visit
    array unset visit
}

proc mark-visited {x y d} {
    global visit
    set v [switch -exact -- $d n {expr 1} s {expr 2} w {expr 4} e {expr 8} default {error "invalid dir '$d'"}]
    incr visit($y,$x) 0
    set result [expr {($visit($y,$x) & $v) != 0}]
    set visit($y,$x) [expr {$visit($y,$x) | $v}]
    return $result
}

proc print-visited {} {
    global visit
    global width
    global height
    for {set i 0} {$i < $height} {incr i} {
        set row {}
        for {set j 0} {$j < $width} {incr j} {
            if {[info exist visit($i,$j)] && $visit($i,$j)} {
                lappend row "#"
            } else {
                lappend row "."
            }
        }
        puts [join $row ""]
    }
}

proc follow {beams {first 0}} {
    global grid
    set newbeams {}
    foreach {x y d} $beams {
        if {!$first} {
            if { [mark-visited $x $y $d] } continue
            switch $d {
                n { incr y -1 }
                s { incr y +1 }
                w { incr x -1 }
                e { incr x +1 }
            }
        }
        if {[info exists grid($y,$x)]} {
            switch -exact "$grid($y,$x) $d" {
                {\ n} { set d w }
                {\ s} { set d e }
                {\ e} { set d s }
                {\ w} { set d n }
                {/ n} { set d e }
                {/ s} { set d w }
                {/ e} { set d n }
                {/ w} { set d s }
                {| w} { set d {n s} }
                {| e} { set d {n s} }
                {- n} { set d {w e} }
                {- s} { set d {w e} }
            }
            foreach d' [split $d] {
                lappend newbeams $x $y ${d'}
            }
        }
    }
    return $newbeams
}

proc solve {} {
    global visit
    reset-visited
    set beams [follow {0 0 e} 1]
    while {[llen $beams] > 0} {
        set beams [follow $beams]
    }
    print-visited
    puts [array size visit]
}

proc lmax {list} {
    set t 0
    foreach x $list { if {$t < $x} {set t $x} }
    return $t
}

proc solve2 {} {
    global grid
    global width
    global height
    global visit
    puts "width=$width height=$height"

    set edges {}
    foreach k [array names grid] {
        lassign [split $k ","] y x
        if {$x == 0} { lappend edges [list $x $y e] }
        if {$y == 0} { lappend edges [list $x $y s] }
        if {$x == $width - 1} { lappend edges [list $x $y n] }
        if {$y == $height - 1} { lappend edges [list $x $y w] }
    }

    set l {}
    foreach beams $edges {
        reset-visited
        set beams [follow $beams 1]
        while {[llen $beams] > 0} {
            set beams [follow $beams]
        }
        puts [array size visit]
        lappend l [array size visit]
    }

    puts [lmax $l]
}

read-input stdin
puts [array get grid]
puts [follow {0 0 e}]
puts [array get visit]

solve
solve2