80 lines
1.9 KiB
Tcl
80 lines
1.9 KiB
Tcl
|
#!/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
|