adventofcode2023/day05/sol.tcl

80 lines
1.9 KiB
Tcl
Raw Normal View History

2023-12-08 02:35:27 +00:00
#!/usr/bin/env tclsh
source ../prelude.tcl
proc solve input {
must_regexp {^seeds: ([\d ]+)$} [gets $input] _ seeds
gets $input ;# blank line
while {! [eof $input]} {
must_regexp {^([a-z\-]+) map:$} [gets $input] line name
parse_map $name $input
}
set locs [lmap s $seeds {seed2loc $s 1}]
foreach s $seeds l $locs {
puts "$s => $l"
}
puts "-"
set locs {}
foreach {s n} $seeds {
set l [seed2loc $s $n]
puts "$s $n => $l"
lappend locs [lmap {a b} $l {set a}]
}
puts [min {*}[join $locs]]
}
proc seed2loc {seed count} {
set r [list $seed $count]
foreach name {
seed-to-soil
soil-to-fertilizer
fertilizer-to-water
water-to-light
light-to-temperature
temperature-to-humidity
humidity-to-location
} {
set r [join [lmap {a b} $r {lookup $name $a $b}]]
}
return $r
}
proc parse_map {name input} {
set m {}
while {[gets $input line] >= 0} {
if {$line eq ""} break
lappend m $line
}
set ::map($name) [join $m]
puts "$name => $m"
}
proc lookup {name a n} {
set r {} ;# (start count)
set used {} ;# (start end)
set end [expr {$a+$n}]
foreach {dst src count} $::map($name) {
if {$end <= $src || $src+$count <= $a} continue ;# no overlap
set b [expr {max($a,$src)}]
set c [expr {min($end,$src+$count)}]
lappend used $b $c
lappend r [expr {$b-$src+$dst}] [expr {$c-$b}]
}
# unused values translate to themselves
set used [lsort -integer $used]
#puts "$a $end used: $used"
foreach {b c} $used {
if {$a < $b} {
lappend r $a [expr {$b-$a}]
} elseif {$a > $b} {
error "a > b: $a > $b"
}
set a $c
}
if {$a < $end} {
lappend r $a [expr {$end-$a}]
}
return $r
}
solve stdin