adventofcode2023/day16/sol.tcl

142 lines
3.2 KiB
Tcl
Executable File

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