adventofcode2023/day14/sol.tcl

#!/usr/bin/env tclsh
source ../prelude.tcl
set input stdin

proc roll-left lane {
    set prev {}
    while {$prev ne $lane} {
        set prev $lane
        regsub -all {(\.+)(O+)} $lane {\2\1} lane
    }
    return $lane
}

proc roll-right lane {
    set prev {}
    while {$prev ne $lane} {
        set prev $lane
        regsub -all {(O+)(\.+)} $lane {\2\1} lane
    }
    return $lane
}

proc cycle map {
    set map [lmap l [transpose $map] {roll-left $l}] ;# North
    set map [lmap l [transpose $map] {roll-left $l}] ;# West
    set map [lmap l [transpose $map] {roll-right $l}] ;# South
    set map [lmap l [transpose $map] {roll-right $l}] ;# East
    return $map
}

proc calc-load lane {
    set N [slen $lane]
    set load 0
    for {set i 0} {$i < $N} {incr i} {
        if {[string index $lane $i] eq "O"} {
            incr load [expr {$N - $i}]
        }
    }
    return $load
}

set map {}
while {[gets $input line] >= 0} {
    lappend map $line
}

set part1 0
foreach l [transpose $map] {
    set r [roll-left $l]
    set n [calc-load $r]
    puts "$l => $r | $n"
    incr part1 $n
}
puts $part1

puts [cycle $map]
puts [cycle [cycle $map]]
puts [cycle [cycle [cycle $map]]]

set start $map
set x 1
set warp 0
set goal 1000000000
for {set i 1} {$i <= $goal} {incr i} {
    set map [cycle $map]
    set ld [ladd [lmap l [transpose $map] {calc-load $l}]]
    puts "$i  ($ld) | $map"
    #if {$i >= $x} {
        #set x [expr {$x*10}]
    #}
    if {!$warp} {
        if {[info exists seen($map)]} {
            puts "$i == $seen($map)"
            set warp [expr {$i - $seen($map)}]
            incr i [expr {int(($goal - $i)/$warp)*$warp}]
            puts "warping to $i"
        }
        set seen($map) $i
    }
}
#puts "$goal\t| $map"
#puts [ladd [lmap l [transpose $map] {calc-load $l}]]