adventofcode2023/day16/sol.tcl

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

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

proc mark-visited {visitp x y d} {
    if {$x < 0} {return 0}
    upvar $visitp 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 follow {gridp visitp beams {first 0}} {
    upvar $gridp grid
    upvar $visitp visit
    set newbeams {}
    foreach {x y d} $beams {
        if {!$first} {
            if { [mark-visited visit $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)]} continue
        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 grid
    set beams [follow grid visit {0 0 e} 1]
    while {[llen $beams] > 0} {
        set beams [follow grid visit $beams]
    }
    set t 0
    set N 10
    for {set i 0} {$i < $N} {incr i} {
        set row {}
        for {set j 0} {$j < $N} {incr j} {
            if {[info exists visit($i,$j)] && $visit($i,$j)} {
                lappend row "#"
                incr t
            } else {
                lappend row "."
            }
        }
        puts [join $row ""]
    }
    puts [array size visit]
}

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

proc solve2 {width height} {
    global grid
    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 {
        array unset visit
        set beams [follow grid visit $beams 1]
        while {[llen $beams] > 0} {
            set beams [follow grid visit $beams]
        }
        puts [array size visit]
        lappend l [array size visit]
    }

    puts [lmax $l]
}

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

solve
solve2 110 110