refactoring in playground, use zip file for web

playground/samples/aoc2024/Aoc.newt

@@ -0,0 +1 @@
+../../../aoc2023/Aoc.newt

playground/samples/aoc2024/Day1.newt

@@ -0,0 +1,60 @@
+module Day1
+
+import Prelude
+import Node
+import Aoc
+
+pairUp : List Int -> List (Int × Int)
+pairUp (a :: b :: rest) = (a,b) :: pairUp rest
+pairUp (a :: rest) = trace "fail" Nil
+pairUp Nil = Nil
+
+dist : (Int × Int) → Int
+dist (a,b) = if a < b then b - a else a - b
+
+part1 : String -> Int
+part1 text =
+  let pairs = pairUp $ join $ map nums $ split text "\n"
+      left  = qsort _<_ $ map fst pairs
+      right = qsort _<_ $ map snd pairs
+      dists = map dist $ zip left right
+  in foldl _+_ 0 dists
+
+
+lookup : ∀ a b. {{Eq a}} → a → List (a × b) → Maybe b
+lookup key Nil = Nothing
+lookup key ((k,v) :: rest) = if k == key then Just v else lookup key rest
+
+
+coalesce : List Int → Int -> List (Int × Int)
+coalesce (a :: b :: rest) cnt =
+  if a == b then coalesce (b :: rest) (cnt + 1) else (a,cnt) :: coalesce (b :: rest) 1
+coalesce (a :: Nil) cnt = (a,cnt) :: Nil
+coalesce Nil cnt = Nil
+
+cross : List (Int × Int) → List (Int × Int) → Int → Int
+cross xs ys acc =
+  let ((a,cnt) :: xs') = xs | Nil => acc in
+  let ((b,cnt') :: ys') = ys | Nil => acc in
+  if a == b then cross xs' ys' (acc + a * cnt * cnt')
+  else if a < b then cross xs' ys acc
+  else cross xs ys' acc
+
+part2 : String → Int
+part2 text =
+  let pairs = pairUp $ join $ map nums $ split text "\n"
+      left  = coalesce (qsort _<_ $ map fst pairs) 1
+      right = coalesce (qsort _<_ $ map snd pairs) 1
+  in cross left right 0
+
+run : String -> IO Unit
+run fn = do
+  putStrLn fn
+  text <- readFile fn
+  putStrLn $ "part1 " ++ show (part1 text)
+  putStrLn $ "part2 " ++ show (part2 text)
+
+main : IO Unit
+main = do
+  run "aoc2024/day1/eg.txt"
+  run "aoc2024/day1/input.txt"

playground/samples/aoc2024/Day2.newt

@@ -0,0 +1,51 @@
+module Day2
+
+import Prelude
+import Node
+import Aoc
+
+decr : List Int → Bool
+decr (x :: y :: _) = y < x
+decr _ = False
+
+diff : Int → Int → Int
+diff x y = if x < y then y - x else x - y
+
+isSafe : Bool → List Int → Bool
+isSafe decr (x :: y :: rest) =
+  let d = diff x y
+      good = 0 < d && d < 4
+      safe = if x < y then not decr && good else decr && good in
+  if safe then isSafe decr (y :: rest) else False
+isSafe _ _ = True
+
+check : List Int → Bool
+check x = isSafe (decr x) x
+
+any : ∀ a. (a → Bool) → List a → Bool
+any f xs = foldl (_||_) False $ map f xs
+
+alts : List Int → List (List Int)
+alts Nil = Nil
+alts (x :: xs) = xs :: map (_::_ x) (alts xs)
+
+-- I want lean's #eval here
+
+parse : String → List (List Int)
+parse text = map nums $ split (trim text) "\n"
+
+run : String -> IO Unit
+run fn = do
+  putStrLn fn
+  text <- readFile fn
+  let stuff = parse text
+  let good = filter check stuff
+  putStrLn $ "part1 " ++ show (length good)
+  let good = filter (any check ∘ alts) stuff
+  putStrLn $ "part2 " ++ show (length good)
+
+main : IO Unit
+main = do
+  run "aoc2024/day2/eg.txt"
+  run "aoc2024/day2/input.txt"
+

playground/samples/aoc2024/Day3.newt

@@ -0,0 +1,121 @@
+module Day3
+
+import Prelude
+import Node
+import Aoc
+
+Parser : U → U
+Parser a = List Char → Maybe (a × List Char)
+
+instance Monad Parser where
+  pure a = \ cs => Just (a, cs)
+  bind ma mab = \ cs => ma cs >>= uncurry mab
+
+instance Alternative Parser where
+  pa <|> pb = \ cs => case pa cs of
+    Nothing => pb cs
+    res => res
+
+fail : ∀ a. Parser a
+fail = \ cs => Nothing
+
+satisfy : (Char → Bool) → Parser Char
+satisfy pred = λ cs => case cs of
+  Nil => Nothing
+  (c :: cs) => if pred c then Just (c, cs) else Nothing
+
+match : Char → Parser Char
+match d = satisfy (_==_ d)
+
+any : Parser Char
+any = satisfy (λ _ => True)
+
+some many : ∀ a. Parser a → Parser (List a)
+many p = some p <|> pure Nil
+some p = do
+  v <- p
+  vs <- many p
+  pure (v :: vs)
+
+pnum : Parser Int
+pnum = do
+  chars <- many (satisfy isDigit)
+  if S (S (S Z)) < length chars then fail
+    else pure $ stringToInt $ pack chars
+
+data Inst : U where
+  Mult : Int → Int → Inst
+  Do : Inst
+  Dont : Inst
+
+mul : Parser Inst
+mul = do
+  match 'm'
+  match 'u'
+  match 'l'
+  match '('
+  x <- pnum
+  match ','
+  y <- pnum
+  match ')'
+  pure $ Mult x y
+
+pdo : Parser Inst
+pdo = do
+  match 'd'
+  match 'o'
+  match '('
+  match ')'
+  pure Do
+
+pdont : Parser Inst
+pdont = do
+  match 'd'
+  match 'o'
+  match 'n'
+  match '\''
+  match 't'
+  match '('
+  match ')'
+  pure Dont
+
+some' many' : ∀ a. Parser a → Parser (List a)
+many' p = do
+  pure MkUnit
+  some' p <|> (any >> many' p) <|> pure Nil
+
+some' p = do
+  v <- p
+  vs <- many' p
+  pure (v :: vs)
+
+inst : Parser Inst
+inst = mul <|> pdo <|> pdont
+
+pfile : Parser (List Inst)
+pfile = many' inst
+
+value : Inst → Int
+value (Mult x y) = x * y
+value _ = 0
+
+part2 : List Inst → Bool → Int → Int
+part2 Nil _ acc = acc
+part2 (Do :: insts) _ acc = part2 insts True acc
+part2 (Dont :: insts) _ acc = part2 insts False acc
+part2 (_ :: insts) False acc = part2 insts False acc
+part2 (Mult x y :: insts) True acc = part2 insts True (acc + x * y)
+
+run : String → IO Unit
+run fn = do
+  putStrLn fn
+  text <- trim <$> readFile fn
+  let (Just (insts, Nil)) = pfile (unpack text) | _ => putStrLn "parse failed"
+  let part1 = foldl _+_ 0 $ map value insts
+  putStrLn $ "part1 " ++ show part1
+  putStrLn $ "part2 " ++ show (part2 insts True 0)
+
+main : IO Unit
+main = do
+  run "aoc2024/day3/eg.txt"
+  run "aoc2024/day3/input.txt"

playground/samples/aoc2024/Day4.newt

@@ -0,0 +1,76 @@
+module Day4
+
+import Prelude
+import Node
+import Aoc
+
+data Problem : U where
+  P : Int → String → Problem
+
+get : Problem → Int → Int → Char
+get (P size text) r c =
+  if r < 0 || size <= r then '.'
+  else if c < 0 || size <= c then '.'
+  else sindex text (r * (size + 1) + c)
+
+check : Problem → Int → Int → Int × Int → Int
+check prob r c (dr,dc) =
+  if (get prob r c) /= 'X' then 0
+  else if (get prob (r + dr) (c + dc)) /= 'M' then 0
+  else if (get prob (r + 2 * dr) (c + 2 * dc)) /= 'A' then 0
+  else if (get prob (r + 3 * dr) (c + 3 * dc)) /= 'S' then 0
+  else 1
+
+dirs : List (Int × Int)
+dirs = tail $ _,_ <$> 0 :: 0 - 1 :: 1 :: Nil <*> 0 :: 0 - 1 :: 1 :: Nil
+
+part1 : Problem → Int
+part1 (P size text) = go 0 0 0
+  where
+    go : Int → Int → Int → Int
+    go acc r c =
+      if r == size then acc else
+      if c == size then go acc (r + 1) 0 else
+      let acc = foldl _+_ acc $ map (check (P size text) r c) dirs in
+      go acc r (c + 1)
+
+pats : List (Char × Char × Char × Char)
+pats = ('M', 'M', 'S', 'S') ::
+       ('S', 'M', 'M', 'S') ::
+       ('S', 'S', 'M', 'M') ::
+       ('M', 'S', 'S', 'M') ::
+       Nil
+
+check2 : Problem → Int → Int → (Char × Char × Char × Char) → Int
+check2 prob r c (w,x,y,z) =
+  if (get prob r c) /= 'A' then 0
+  else if (get prob (r - 1) (c - 1)) /= w then 0
+  else if (get prob (r - 1) (c + 1)) /= x then 0
+  else if (get prob (r + 1) (c + 1)) /= y then 0
+  else if (get prob (r + 1) (c - 1)) /= z then 0
+  else 1
+
+part2 : Problem → Int
+part2 (P size text) = go 0 0 0
+  where
+    go : Int → Int → Int → Int
+    go acc r c =
+      if r == size then acc else
+      if c == size then go acc (r + 1) 0 else
+      let acc = foldl _+_ acc $ map (check2 (P size text) r c) pats in
+      go acc r (c + 1)
+
+run : String -> IO Unit
+run fn = do
+  putStrLn fn
+  text <- readFile fn
+  let lines = split (trim text) "\n"
+  -- I'm going to assume it's square for convenience
+  let size = length lines
+  printLn $ "part1 " ++ show (part1 $ P (cast size) text)
+  printLn $ "part2 " ++ show (part2 $ P (cast size) text)
+
+main : IO Unit
+main = do
+  run "aoc2024/day4/eg.txt"
+  run "aoc2024/day4/input.txt"

playground/samples/aoc2024/Day5.newt

@@ -0,0 +1,77 @@
+module Day5
+
+import Prelude
+import Node
+import Aoc
+import SortedMap
+
+data Prob : U where
+  MkProb : List (Int × Int) -> List (List Int) → Prob
+
+parseRule : String → Maybe (Int × Int)
+parseRule txt =
+  let (a :: b :: Nil) = nums' "|" txt  | _ => Nothing
+  in Just (a,b)
+
+parse : String → Maybe Prob
+parse text = do
+  let (a :: b :: Nil) = split (trim text) "\n\n" | pts => Nothing
+  rules <- traverse parseRule $ split a "\n"
+  let updates = map (nums' ",") $ split b "\n"
+  Just $ MkProb rules updates
+
+RuleMap : U
+RuleMap = SortedMap Int (List Int)
+
+getDisallowed : Int → RuleMap → List Int
+getDisallowed key rmap = fromMaybe Nil (map snd $ lookupMap key rmap)
+
+mkRuleMap : List (Int × Int) -> RuleMap
+mkRuleMap rules = foldl go EmptyMap rules
+  where
+    go : RuleMap → Int × Int → RuleMap
+    go rmap (b,a) = updateMap a (b :: getDisallowed a rmap) rmap
+
+scan : RuleMap → List Int -> List Int -> Bool
+scan rmap interdit Nil = True
+scan rmap interdit (x :: xs) =
+  if elem x interdit then False
+  else scan rmap (getDisallowed x rmap ++ interdit) xs
+
+fix : RuleMap → List Int → List Int
+fix rmap Nil = Nil
+fix rmap (x :: xs) =
+  let interdit = getDisallowed x rmap in
+  let (prefix,rest) = partition (flip elem interdit) xs
+  in case prefix of
+    Nil => x :: fix rmap rest
+    ys => fix rmap (ys ++ x :: rest)
+
+middle : List Int -> Int
+middle xs = go xs xs
+  where
+    go : List Int → List Int → Int
+    go (x :: xs) (_ :: _ :: ys) = go xs ys
+    go (x :: xs) (_ :: ys) = x
+    go _ _ = 0
+
+run : String -> IO Unit
+run fn = do
+  putStrLn fn
+  text <- readFile fn
+  let (Just prob) = parse text | _ => putStrLn "Parse Error"
+  let (MkProb rules things) = prob
+  let rmap = mkRuleMap rules
+  let good = filter (scan rmap Nil) things
+  let part1 = foldl _+_ 0 $ map middle good
+  let bad = filter (not ∘ scan rmap Nil) things
+  putStrLn $ "part1 " ++ show part1
+  let fixed = map (fix rmap) bad
+  printLn $ length bad
+  let part2 = foldl _+_ 0 $ map middle fixed
+  putStrLn $ "part2 " ++ show part2
+
+main : IO Unit
+main = do
+  run "aoc2024/day5/eg.txt"
+  run "aoc2024/day5/input.txt"

playground/samples/aoc2024/Day6.newt

@@ -0,0 +1,132 @@
+module Day6
+
+import Prelude
+import Node
+import Aoc
+import SortedMap
+
+Point : U
+Point = Int × Int
+
+instance Eq Point where
+  (a,b) == (c,d) = a == c && b == d
+
+instance Ord Point where
+  (a,b) < (c,d) = a < c || a == c && b < d
+
+Grid : U
+Grid = SortedMap Point Char
+
+loadData : String → Grid
+loadData text = go (unpack text) 0 0 EmptyMap
+  where
+    go : List Char → Int → Int → SortedMap Point Char → SortedMap Point Char
+    go Nil r c map = map
+    go ('\n' :: cs) r c map = go cs (r + 1) 0 map
+    go (x :: xs) r c map = go xs r (c + 1) $ updateMap (r,c) x map
+
+data Dir : U where North East South West : Dir
+
+instance Show Dir where
+  show North = "N"
+  show East = "E"
+  show South = "S"
+  show West = "W"
+
+instance Ord Dir where
+  a < b = show a < show b
+
+instance Eq (Point × Dir) where
+  (a,b) == (c,d) = a == c && show b == show d
+
+instance Ord (Point × Dir) where
+  (a,b) < (c,d) =
+    if a < c then True
+    else if a /= c then False
+    else b < d
+
+Done : U
+Done = SortedMap (Point × Dir) Unit
+
+turn : Dir → Dir
+turn North = East
+turn East = South
+turn South = West
+turn West = North
+
+instance Cast Dir Char where
+  cast North = '^'
+  cast East = '>'
+  cast South = 'v'
+  cast West = '<'
+
+step : Dir → Point → Point
+step North (r, c) = (r - 1, c)
+step East (r, c) = (r, c + 1)
+step South (r, c) = (r + 1, c)
+step West (r, c) = (r, c - 1)
+
+bad : Point → Bool
+bad (x,y) = x < 0 || y < 0
+
+-- third is
+walk : Dir → Point → Grid → Grid
+walk dir pos grid =
+  let grid = updateMap pos 'X' grid in
+  let pos' = step dir pos in
+  case lookupMap pos' grid of
+    Just (_, '#') => walk (turn dir) pos grid
+    Nothing => grid
+    _   => walk dir pos' grid
+
+checkLoop : Grid → Done → Dir → Point → Bool
+checkLoop grid done dir pos =
+  let (Nothing) = lookupMap (pos,dir) done | _ => True in
+  let done = updateMap (pos, dir) MkUnit done
+      pos' = step dir pos
+    in case lookupMap pos' grid of
+        Nothing => False
+        Just (_, '#') => checkLoop grid done (turn dir) pos
+        Just _ => checkLoop grid done dir pos'
+
+part2 : Dir → Point → Grid → Done → List Point → List Point
+part2 dir pos grid done sol =
+  let done = updateMap (pos, dir) MkUnit done
+      grid = updateMap pos 'X' grid
+      turnDir = turn dir
+      turnPos = step turnDir pos
+      pos' = step dir pos in
+  case lookupMap pos' grid of
+    Nothing => sol
+    Just (_, '#') => part2 (turn dir) pos grid done sol
+    Just (_, 'X') => part2 dir pos' grid done sol
+    Just (_, '.') => if checkLoop (updateMap pos' '#' grid) done turnDir pos
+      then part2 dir pos' grid done (pos' :: sol)
+      else part2 dir pos' grid done sol
+    Just x => part2 (trace ("WAT " ++ debugStr x) dir) pos' grid done sol
+
+lookupV : ∀ a. Char → List (a × Char) → Maybe a
+lookupV _ Nil = Nothing
+lookupV needle ((k,v) :: rest) =
+  if v == needle then Just k else lookupV needle rest
+
+run : String -> IO Unit
+run fn = do
+  putStrLn fn
+  text <- readFile fn
+  let grid = loadData text
+  let (Just pos) = lookupV '^' (toList grid) | _ => putStrLn "no guard"
+  let grid' = walk North pos grid
+  let xs = filter (\ x => 'X' == snd x) $ toList grid'
+  let part1 = length xs
+  putStrLn $ "part1 " ++ show part1
+
+  let cands = part2 North pos grid EmptyMap Nil
+  -- debugLog $ length cands -- turns out nub isn't needed for these cases, but we'll leave it in
+  putStrLn $ "part2 " ++ show (length $ ordNub cands)
+  printLn $ length $ toList grid
+
+main : IO Unit
+main = do
+  run "aoc2024/day6/eg.txt"
+  run "aoc2024/day6/input.txt"

playground/samples/aoc2024/Day7.newt

@@ -0,0 +1,58 @@
+module Day7
+
+import Prelude
+import Node
+import Aoc
+
+Prob : U
+Prob = Int × List Int
+
+cases : Int → Int → List Int → Bool
+cases goal acc Nil = goal == acc
+cases goal acc (x :: xs) =
+  if goal < acc then False
+  else if cases goal (x + acc) xs then True
+  else cases goal (x * acc) xs
+
+part1 : Prob → Bool
+part1 (goal, x :: xs) = cases goal x xs
+part1 _ = False
+
+cat : Int → Int → Int
+cat x y = stringToInt $ show x ++ show y
+
+cases2 : Int → Int → List Int → Bool
+cases2 goal acc Nil = goal == acc
+cases2 goal acc (x :: xs) =
+  if goal < acc then False
+  else if cases2 goal (x + acc) xs then True
+  else if cases2 goal (x * acc) xs then True
+  else cases2 goal (cat acc x) xs
+
+part2 : Prob → Bool
+part2 (goal, x :: xs) = cases2 goal x xs
+part2 _ = False
+
+parse : String -> Maybe (List Prob)
+parse text = do
+  traverse parseLine $ split (trim text) "\n"
+  where
+    parseLine : String → Maybe Prob
+    parseLine line = do
+      let (a :: b :: Nil) = split line ": " | _ => Nothing
+      Just (stringToInt a , nums b)
+
+run : String -> IO Unit
+run fn = do
+  putStrLn fn
+  text <- readFile fn
+  let (Just probs) = parse text | _ => putStrLn "parse error"
+  let p1 = foldl _+_ 0 $ map fst $ filter part1 probs
+  putStrLn $ "part1 " ++ show p1
+  let p2 = foldl _+_ 0 $ map fst $ filter part2 probs
+  putStrLn $ "part2 " ++ show p2
+
+main : IO Unit
+main = do
+  run "aoc2024/day7/eg.txt"
+  run "aoc2024/day7/input.txt"

playground/samples/aoc2024/Day8.newt

@@ -0,0 +1,95 @@
+module Day8
+
+import Prelude
+import Node
+import Aoc
+import SortedMap
+
+Point : U
+Point = Int × Int
+
+instance Add Point where
+  (a,b) + (c,d) = (a + c, b + d)
+
+instance Sub Point where
+  (a,b) - (c,d) = (a - c, b - d)
+
+Ant : U
+Ant = Char × Int × Int
+
+-- This should be a utility...
+parse : String → List Ant
+parse text = go 0 0 (unpack text) Nil
+  where
+    -- might as well be tail recursive
+    go : Int → Int → List Char → List Ant → List Ant
+    go row col Nil ants = ants
+    go row col ('\n' :: cs) ants = go (row + 1) 0 cs ants
+    go row col (c :: cs) ants = go row (col + 1) cs ((c,row,col) :: ants)
+
+doPair : Point → Point → List Point
+doPair x y = let d = y - x in y + d :: x - d :: Nil
+
+doGroup : List Ant -> List Point
+doGroup (x :: xs) = join $ doGroup xs ::  map (doPair (snd x) ∘ snd) xs
+doGroup Nil = Nil
+
+group : List Ant → (List Ant) → List (List Ant)
+group (a :: as) Nil = group as (a :: Nil)
+group (a :: as) (b :: bs) =
+  if fst a == fst b
+    then group as (a :: b :: bs)
+    else (b :: bs) :: group as (a :: Nil)
+group Nil bs = bs :: Nil
+
+max : Int → Int → Int
+max a b = if a < b then b else a
+
+check : Int → Point → Bool
+check mr (r,c) = 0 <= r && 0 <= c && r <= mr && c <= mr
+
+
+doPair2 : Int -> Point → Point → List Point
+doPair2 m x y = go x (y - x) ++ go y (x - y)
+  where
+    go : Point -> Point -> List Point
+    go pt d = if check m pt then pt :: go (pt + d) d else Nil
+
+doGroup2 : Int -> List Ant -> List Point
+doGroup2 m (x :: xs) = join $ doGroup2 m xs ::  map (doPair2 m (snd x) ∘ snd) xs
+doGroup2 m Nil = Nil
+
+instance Ord Point where
+  (a,b) < (c,d) = a < c || a == c && b < d
+
+instance Eq Point where
+  (a,b) == (c,d) = a == c && b == d
+
+run : String -> IO Unit
+run fn = do
+  putStrLn fn
+  text <- readFile fn
+  let points = parse text
+  let maxrow = trace "maxrow" $ foldl max 0 $ map (fst ∘ snd) points
+  let maxcol = trace "maxcol" $ foldl max 0 $ map (snd ∘ snd) points
+  let ants = filter (\ pt => fst pt /= '.') points
+  let ants = qsort (\ x y => fst x < fst y) ants
+  let groups = group ants Nil
+  let stuff = join $ map doGroup groups
+  let nodes = filter (check maxrow) stuff
+
+  let part1 = length $ ordNub nodes
+  putStrLn $ "part1 " ++ show part1
+
+  let stuff2 = join $ map (doGroup2 maxrow) groups
+  let part2 = length $ ordNub stuff2
+  putStrLn $ "part2 " ++ show part2
+
+
+
+
+
+main : IO Unit
+main = do
+  run "aoc2024/day8/eg.txt"
+  run "aoc2024/day8/input.txt"

playground/samples/aoc2024/Node.newt

@@ -0,0 +1 @@
+../../../aoc2023/Node.newt

playground/samples/aoc2024/Prelude.newt

@@ -0,0 +1 @@
+../../../newt/Prelude.newt

playground/samples/aoc2024/SortedMap.newt

@@ -0,0 +1,67 @@
+module SortedMap
+
+import Prelude
+
+data T23 : Nat -> U -> U -> U where
+  Leaf : ∀ k v. k -> v -> T23 Z k v
+  Node2 : ∀ h k v. T23 h k v -> k -> T23 h k v -> T23 (S h) k v
+  Node3 : ∀ h k v. T23 h k v -> k -> T23 h k v -> k -> T23 h k v -> T23 (S h) k v
+
+lookupT23 : ∀ h k v. {{Ord k}} {{Eq k}} -> k -> T23 h k v -> Maybe (k × v)
+lookupT23 key (Leaf k v)= if k == key then Just (k,v) else Nothing
+lookupT23 key (Node2 t1 k1 t2) =
+  if key <= k1 then lookupT23 key t1 else lookupT23 key t2
+lookupT23 key (Node3 t1 k1 t2 k2 t3) =
+  if key <= k1 then lookupT23 key t1
+  else if key <= k2 then lookupT23 key t2
+  else lookupT23 key t3
+
+insertT23 : ∀ h k v. {{Ord k}} {{Eq k}} -> k -> v -> T23 h k v -> Either (T23 h k v) (T23 h k v × k × T23 h k v)
+insertT23 key value (Leaf k v) =
+  if key == k then Left (Leaf key value)
+  else if key <= k then Right (Leaf key value, key, Leaf k v)
+  else Right (Leaf k v, k, Leaf key value)
+insertT23 key value (Node2 t1 k1 t2) =
+  if key <= k1 then
+    case insertT23 key value t1 of
+      Left t1' => Left (Node2 t1' k1 t2)
+      Right (a,b,c) => Left (Node3 a b c k1 t2)
+  else case insertT23 key value t2 of
+      Left t2' => Left (Node2 t1 k1 t2')
+      Right (a,b,c) => Left (Node3 t1 k1 a b c)
+insertT23 key value (Node3 t1 k1 t2 k2 t3) =
+  if key <= k1 then
+    case insertT23 key value t1 of
+      Left t1' => Left (Node3 t1' k1 t2 k2 t3)
+      Right (a,b,c) => Right (Node2 a b c, k1, Node2 t2 k2 t3)
+  else if key <= k2 then
+    case insertT23 key value t2 of
+      Left t2' => Left (Node3 t1 k1 t2' k2 t3)
+      Right (a,b,c) => Right (Node2 t1 k1 a, b, Node2 c k2 t3)
+  else
+    case insertT23 key value t3 of
+      Left t3' => Left (Node3 t1 k1 t2 k2 t3')
+      Right (a,b,c) => Right (Node2 t1 k1 t2, k2, Node2 a b c)
+
+data SortedMap : U -> U -> U where
+  EmptyMap : ∀ k v. SortedMap k v
+  MapOf : ∀ k v h. T23 h k v -> SortedMap k v
+
+lookupMap : ∀ k v. {{Ord k}} {{Eq k}} -> k -> SortedMap k v -> Maybe (k × v)
+lookupMap k EmptyMap = Nothing
+lookupMap k (MapOf map) = lookupT23 k map
+
+updateMap : ∀ k v. {{Ord k}} {{Eq k}} -> k -> v -> SortedMap k v -> SortedMap k v
+updateMap k v EmptyMap = MapOf $ Leaf k v
+updateMap k v (MapOf map) = case insertT23 k v map of
+  Left map' => MapOf map'
+  Right (a, b, c) => MapOf (Node2 a b c)
+
+toList : ∀ k v. SortedMap k v → List (k × v)
+toList {k} {v} (MapOf smap) = reverse $ go smap Nil
+  where
+    go : ∀ h. T23 h k v → List (k × v) → List (k × v)
+    go (Leaf k v) acc = (k, v) :: acc
+    go (Node2 t1 k1 t2) acc = go t2 (go t1 acc)
+    go (Node3 t1 k1 t2 k2 t3) acc = go t3 $ go t2 $ go t1 acc
+toList _ = Nil

playground/samples/aoc2024/day1/eg.txt

@@ -0,0 +1,6 @@
+3   4
+4   3
+2   5
+1   3
+3   9
+3   3

playground/samples/aoc2024/day2/eg.txt

@@ -0,0 +1,6 @@
+7 6 4 2 1
+1 2 7 8 9
+9 7 6 2 1
+1 3 2 4 5
+8 6 4 4 1
+1 3 6 7 9

playground/samples/aoc2024/day3/eg.txt

@@ -0,0 +1 @@
+xmul(2,4)%&mul[3,7]!@^do_not_mul(5,5)+mul(32,64]then(mul(11,8)mul(8,5))

playground/samples/aoc2024/day4/eg.txt

@@ -0,0 +1,11 @@
+MMMSXXMASM
+MSAMXMSMSA
+AMXSXMAAMM
+MSAMASMSMX
+XMASAMXAMM
+XXAMMXXAMA
+SMSMSASXSS
+SAXAMASAAA
+MAMMMXMMMM
+MXMXAXMASX
+

playground/samples/aoc2024/day5/eg.txt

@@ -0,0 +1,28 @@
+47|53
+97|13
+97|61
+97|47
+75|29
+61|13
+75|53
+29|13
+97|29
+53|29
+61|53
+97|53
+61|29
+47|13
+75|47
+97|75
+47|61
+75|61
+47|29
+75|13
+53|13
+
+75,47,61,53,29
+97,61,53,29,13
+75,29,13
+75,97,47,61,53
+61,13,29
+97,13,75,29,47

playground/samples/aoc2024/day6/eg.txt

@@ -0,0 +1,11 @@
+....#.....
+.........#
+..........
+..#.......
+.......#..
+..........
+.#..^.....
+........#.
+#.........
+......#...
+

playground/samples/aoc2024/day7/eg.txt

@@ -0,0 +1,9 @@
+190: 10 19
+3267: 81 40 27
+83: 17 5
+156: 15 6
+7290: 6 8 6 15
+161011: 16 10 13
+192: 17 8 14
+21037: 9 7 18 13
+292: 11 6 16 20

playground/samples/aoc2024/day8/day1/eg.txt

@@ -0,0 +1,6 @@
+3   4
+4   3
+2   5
+1   3
+3   9
+3   3

playground/samples/aoc2024/day8/day2/eg.txt

@@ -0,0 +1,6 @@
+7 6 4 2 1
+1 2 7 8 9
+9 7 6 2 1
+1 3 2 4 5
+8 6 4 4 1
+1 3 6 7 9

playground/samples/aoc2024/day8/day3/eg.txt

@@ -0,0 +1 @@
+xmul(2,4)%&mul[3,7]!@^do_not_mul(5,5)+mul(32,64]then(mul(11,8)mul(8,5))

playground/samples/aoc2024/day8/day4/eg.txt

@@ -0,0 +1,11 @@
+MMMSXXMASM
+MSAMXMSMSA
+AMXSXMAAMM
+MSAMASMSMX
+XMASAMXAMM
+XXAMMXXAMA
+SMSMSASXSS
+SAXAMASAAA
+MAMMMXMMMM
+MXMXAXMASX
+

playground/samples/aoc2024/day8/day5/eg.txt

@@ -0,0 +1,28 @@
+47|53
+97|13
+97|61
+97|47
+75|29
+61|13
+75|53
+29|13
+97|29
+53|29
+61|53
+97|53
+61|29
+47|13
+75|47
+97|75
+47|61
+75|61
+47|29
+75|13
+53|13
+
+75,47,61,53,29
+97,61,53,29,13
+75,29,13
+75,97,47,61,53
+61,13,29
+97,13,75,29,47

playground/samples/aoc2024/day8/day6/eg.txt

@@ -0,0 +1,11 @@
+....#.....
+.........#
+..........
+..#.......
+.......#..
+..........
+.#..^.....
+........#.
+#.........
+......#...
+

playground/samples/aoc2024/day8/day7/eg.txt

@@ -0,0 +1,9 @@
+190: 10 19
+3267: 81 40 27
+83: 17 5
+156: 15 6
+7290: 6 8 6 15
+161011: 16 10 13
+192: 17 8 14
+21037: 9 7 18 13
+292: 11 6 16 20

playground/samples/aoc2024/day8/eg.txt

@@ -0,0 +1,12 @@
+............
+........0...
+.....0......
+.......0....
+....0.......
+......A.....
+............
+............
+........A...
+.........A..
+............
+............