From 16bf45bcbf4afb89542050b52f0d08f323ec4b9a Mon Sep 17 00:00:00 2001
From: magical <magical@tilde.town>
Date: Thu, 7 Dec 2023 18:35:27 -0800
Subject: [PATCH] day 5 tcl solution

---
 day05/sol.tcl | 79 +++++++++++++++++++++++++++++++++++++++++++++++++++
 prelude.tcl   |  5 ++++
 2 files changed, 84 insertions(+)
 create mode 100755 day05/sol.tcl

diff --git a/day05/sol.tcl b/day05/sol.tcl
new file mode 100755
index 0000000..84b4640
--- /dev/null
+++ b/day05/sol.tcl
@@ -0,0 +1,79 @@
+#!/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
diff --git a/prelude.tcl b/prelude.tcl
index d7d7389..9898df8 100644
--- a/prelude.tcl
+++ b/prelude.tcl
@@ -16,3 +16,8 @@ proc lmul {list} {
     return $p
 }
 
+proc must_regexp args {
+    if {! [uplevel [concat regexp $args]]} {
+        error "regexp failed"
+    }
+}