From 067293ea8589b9802e787485b921279152cf7f56 Mon Sep 17 00:00:00 2001
From: Steve Dunham <dunhamsteve@gmail.com>
Date: Sat, 30 Nov 2024 11:50:24 -0800
Subject: [PATCH] Day5

---
 TODO.md             |   1 +
 aoc2023/Day5.newt   | 125 ++++++++++++++++++++++++++++++++++++++++++++
 aoc2023/day5/eg.txt |  33 ++++++++++++
 3 files changed, 159 insertions(+)
 create mode 100644 aoc2023/Day5.newt
 create mode 100644 aoc2023/day5/eg.txt

diff --git a/TODO.md b/TODO.md
index 9426813..94f81a7 100644
--- a/TODO.md
+++ b/TODO.md
@@ -3,6 +3,7 @@
 
 - [ ] Add icit to Lam (see `check` for details)
 - [ ] TCO? Probably needed in browser, since v8 doesn't do it. bun and JavaScriptCore do support it.
+- [ ] deconstructing `let`
 - [x] Fix string printing to be js instead of weird Idris strings
 - [ ] make $ special
   - Makes inference easier, cleaner output, and allows `foo $ \ x => ...`
diff --git a/aoc2023/Day5.newt b/aoc2023/Day5.newt
new file mode 100644
index 0000000..5cbeb46
--- /dev/null
+++ b/aoc2023/Day5.newt
@@ -0,0 +1,125 @@
+module Day5
+
+import Prelude
+import Node
+
+-- AoC lib?
+nums : String → List Int
+nums s = map stringToInt $ filter (_/=_ "") $ split (trim s) " "
+
+data MapEntry : U where
+  -- dest / src / len
+  MkEntry : Int → Int → Int → MapEntry
+
+src : MapEntry -> Int
+src (MkEntry d s l) = s
+
+Map : U
+Map = List MapEntry
+
+data Problem : U where
+  MkProb : List Int → List Map → Problem
+
+parseEntry : String → Either String MapEntry
+parseEntry part = case nums part of
+  (dest :: src :: len :: Nil) => Right $ MkEntry dest src len
+  _ => Left $ "Bad part " ++ part
+
+parseMap : List String → Either String Map
+parseMap (_ :: parts) = mapM parseEntry parts
+parseMap x = Left $ "bad map " ++ debugStr x
+
+parseFile : String → Either String Problem
+parseFile content = do
+  let parts = split (trim content) "\n\n"
+  -- TODO deconstructing let
+  case parts of
+    (first :: rest) => case split first ": " of
+      (_ :: x :: Nil) => do
+        let seeds = nums x
+        maps <- mapA (λ part => parseMap (split part "\n")) rest
+        Right $ MkProb seeds maps
+      _ => Left $ "expected ': ' in " ++ first
+    _ => Left $ "expected some parts"
+
+applyEntry : Int → MapEntry → Int
+applyEntry n (MkEntry dest src len) =
+  if src <= n && n < src + len then n + dest - src else n
+
+applyMap : Int → Map → Int
+applyMap n Nil = n
+applyMap n (MkEntry dest src len :: es) =
+  if src <= n && n < src + len then n + dest - src else applyMap n es
+
+min : Int → Int → Int
+min x y = if x < y then x else y
+
+part1 : Problem → IO Unit
+part1 (MkProb seeds maps) = do
+  let loc = map (λ s => foldl applyMap s maps) seeds
+  let part1 = foldl min 999999999 loc
+  putStrLn $ "part1 " ++ show part1
+
+Range : U
+Range = Int × Int
+
+apply' : Range → List MapEntry → List Range
+apply' (r1, r2) x = case x of
+  Nil => (r1, r2) :: Nil
+  (MkEntry d s l) :: es =>
+    if r2 + r1 <= s then (r1,r2) :: Nil -- map after range
+    else if s + l <= r1 then apply' (r1, r2) es -- map before range
+    -- take off any bare range on front
+    else if r1 < s then
+      (r1, s - r1) :: apply' (s, r2 + r1 - s) x
+    else if s + l < r1 + r2 then
+      let slack = r1 - s in
+      (r1 + d - s, l - slack) :: apply' (r1 + l - slack, r2  + slack - l) x
+    else
+      (r1 + d - s, r2) :: Nil
+
+-- probably not super efficient, but it works
+qsort : ∀ a. (a → a → Bool) → List a → List a
+qsort lt Nil = Nil
+qsort lt (x :: xs) = qsort lt (filter (λ y => not $ lt x y) xs) ++ x :: qsort lt (filter (lt x) xs)
+
+apply : List Range → List MapEntry → List Range
+apply ranges entries =
+  let entries = qsort (\ a b => src a < src b) entries in
+  join $ map (\ r => apply' r entries) ranges
+
+mkRanges : List Int → Maybe (List Range)
+mkRanges (a :: b :: rs) = do
+  rs <- mkRanges rs
+  Just $ (a,b) :: rs
+mkRanges Nil = Just Nil
+mkRanges _ = Nothing
+
+part2 : Problem → IO Unit
+part2 (MkProb seeds maps) =
+  case mkRanges seeds of
+    Nothing => printLn "odd seeds!"
+    Just ranges => do
+      let results = foldl apply ranges maps
+      -- putStrLn $ debugStr results
+      let answer = foldl min 99999999 $ map fst results
+      putStrLn $ "part2 " ++ show answer
+
+run : String -> IO Unit
+run fn = do
+  putStrLn fn
+  text <- readFile fn
+  case parseFile text of
+    Left err => putStrLn err
+    Right prob => do
+      putStrLn $ debugStr prob
+      part1 prob
+      -- putStrLn "part2"
+      part2 prob
+
+-- 35 / 46
+-- 282277027 / 11554135
+main : IO Unit
+main = do
+  run "aoc2023/day5/eg.txt"
+  run "aoc2023/day5/input.txt"
diff --git a/aoc2023/day5/eg.txt b/aoc2023/day5/eg.txt
new file mode 100644
index 0000000..f756727
--- /dev/null
+++ b/aoc2023/day5/eg.txt
@@ -0,0 +1,33 @@
+seeds: 79 14 55 13
+
+seed-to-soil map:
+50 98 2
+52 50 48
+
+soil-to-fertilizer map:
+0 15 37
+37 52 2
+39 0 15
+
+fertilizer-to-water map:
+49 53 8
+0 11 42
+42 0 7
+57 7 4
+
+water-to-light map:
+88 18 7
+18 25 70
+
+light-to-temperature map:
+45 77 23
+81 45 19
+68 64 13
+
+temperature-to-humidity map:
+0 69 1
+1 0 69
+
+humidity-to-location map:
+60 56 37
+56 93 4