port aoc2023 day4

more stuff in Prelude, typechecking fixes, solving autos

aoc2023/Day2.newt

@@ -21,14 +21,6 @@ pfunc repr : {a : U} -> a -> String := `(a,o) => ''+o`
 pfunc jrepr : {a : U} -> a -> String := `(a,o) => JSON.stringify(o, null, '  ')`
 pfunc toInt : String -> Int := `s => Number(s)`
 
-mapM : ∀ a b c. (a -> Either b c) -> List a -> Either b (List c)
-mapM f Nil = Right Nil
-mapM f (x :: xs) = case f x of
-  Left msg => Left msg
-  Right v => case mapM f xs of
-    Left msg => Left msg
-    Right vs => Right $ v :: vs
-
 maxd : Draw -> Draw -> Draw
 maxd (a,b,c) (d,e,f) = (max a d, max b e, max c f)
 
@@ -42,10 +34,12 @@ parseColor line = case split line " " of
   (n :: "blue" :: Nil) => Right (0,0,toInt n)
   x => Left $ "Bad draw" ++ repr x
 
+-- FIXME implicit isn't being solved in time here.
 parseDraw : String -> Either String Draw
-parseDraw line = case mapM parseColor $ split line ", " of
-  Right parts => Right $ foldl maxd (0,0,0) parts
-  Left err => Left err
+parseDraw line =
+  case mapM {Either String} parseColor $ split line ", " of
+    Right parts => Right $ foldl maxd (0,0,0) parts
+    Left err => Left err
 
 parseGame : String -> Either String Game
 parseGame line =
@@ -55,7 +49,7 @@ parseGame line =
     (a :: b :: Nil) => case split a " " of
       ("Game" :: ns :: Nil) =>
         let num = toInt ns in
-        case mapM parseDraw $ split b "; " of
+        case mapM {Either String} parseDraw $ split b "; " of
           Right parts => Right $ MkGame num parts
           Left err => Left err
       _ => Left "No Game"
@@ -79,7 +73,7 @@ run : String -> IO Unit
 run fn = do
   putStrLn fn
   text <- readFile fn
-  case mapM parseGame (split (trim text) "\n") of
+  case mapM {Either String} parseGame (split (trim text) "\n") of
     Left err => putStrLn $ "fail " ++ err
     Right games => do
       putStrLn "part1"

aoc2023/Day3.newt

@@ -6,7 +6,6 @@ import Node
 pfunc repr : {a : U} -> a -> String := `(a,o) => ''+o`
 pfunc jrepr : {a : U} -> a -> String := `(a,o) => JSON.stringify(o, null, '  ')`
 
-pfunc trace : ∀ a. String -> a -> a := `(_, msg, a) => { console.log(msg,debugStr(_,a)); return a }`
 
 maybe : ∀ a b. b → (a → b) → Maybe a → b
 maybe def f Nothing = def

aoc2023/Day4.newt

@@ -0,0 +1,67 @@
+module Day4
+
+import Prelude
+import Node
+
+Round : U
+Round = List Int × List Int
+
+parseRound : String → Maybe Round
+parseRound s =
+  case split s ": " of
+    (a :: b :: Nil) => case split b " | " of
+      (l :: r :: Nil) => Just (nums l, nums r)
+      _ => Nothing
+    _ => Nothing
+  where
+    -- Nat or Int here?
+    nums : String → List Int
+    -- catch - split returns empty strings that become zeros
+    nums s = map stringToInt $ filter (_/=_ "") $ split (trim s) " "
+
+parse : String -> Maybe (List Round)
+parse s = mapM parseRound (split (trim s) "\n")
+
+pfunc pow : Int → Int → Int := `(x,y) => x ** y`
+
+part1 : List Round → Int
+part1 rounds = foldl _+_ 0 $ map score rounds
+  where
+    -- TODO we'll keep the math in Int land until we have magic Nat
+    score : Round → Int
+    score (a,b) = let count = natToInt $ length $ filter (\ n => elem n b) a
+      in if count == 0 then 0 else pow 2 (count - 1)
+
+part2 : List Round → Int
+part2 rounds = go 0 $ map (_,_ 1) rounds
+  where
+    mark : Int -> Nat → List (Int × Round) → List (Int × Round)
+    mark _ _ Nil = Nil
+    mark v Z rounds = rounds
+    mark v (S k) ((cnt, round) :: rounds) = (cnt + v, round) :: mark v k rounds
+
+    go : Int → List (Int × Round) → Int
+    go acc Nil = acc
+    go acc ((cnt, a, b) :: rounds) =
+      let n = length $ filter (\ n => elem n b) a
+      in go (acc + cnt) $ mark cnt n rounds
+
+run : String -> IO Unit
+run fn = do
+  putStrLn fn
+  text <- readFile fn
+
+  case parse text of
+    Nothing => putStrLn "fail"
+    Just cards => do
+      putStrLn "part1"
+      printLn (part1 cards)
+      putStrLn "part2"
+      printLn (part2 cards)
+
+-- 13/30
+-- 25004/14427616
+main : IO Unit
+main = do
+  run "aoc2023/day4/eg.txt"
+  run "aoc2023/day4/input.txt"

aoc2023/Prelude.newt

@@ -26,6 +26,10 @@ infixl 6 _==_
 class Eq a where
   _==_ : a → a → Bool
 
+infixl 6 _/=_
+_/=_ : ∀ a. {{Eq a}} → a → a → Bool
+a /= b = not (a == b)
+
 data Nat : U where
   Z : Nat
   S : Nat -> Nat
@@ -159,6 +163,14 @@ class Applicative (f : U → U) where
   return : {0 a} → a → f a
   _<*>_ : {0 a b} -> f (a → b) → f a → f b
 
+class Traversable (t : U → U) where
+  traverse : {f : U → U} → {{appf : Applicative f}} → {a : U} → {b : U} → (a → f b) → t a → f (t b)
+
+instance Applicative Maybe where
+  return a = Just a
+  Nothing <*> _ = Nothing
+  Just f <*> fa = f <$> fa
+
 infixr 2 _<|>_
 class Alternative (m : U → U) where
   _<|>_ : {0 a} → m a → m a → m a
@@ -306,6 +318,21 @@ instance Monad List where
   bind Nil amb = Nil
   bind (x :: xs) amb = amb x ++ bind xs amb
 
+
+
+-- This is traverse, but we haven't defined Traversable yet
+mapA : ∀ m. {{Applicative m}} {0 a b} → (a → m b) → List a → m (List b)
+mapA f Nil = return Nil
+mapA f (x :: xs) = return _::_ <*> f x <*> mapA f xs
+
+
+mapM : ∀ m. {{Monad m}} {0 a b} → (a → m b) → List a → m (List b)
+mapM f Nil = pure Nil
+mapM f (x :: xs) = do
+  b <- f x
+  bs <- mapM f xs
+  pure (b :: bs)
+
 class HasIO (m : U -> U) where
   liftIO : ∀ a. IO a → m a
 
@@ -483,3 +510,30 @@ getAt! : ∀ a. {{Inhabited a}} → Nat → List a → a
 getAt! _ Nil = default
 getAt! Z (x :: xs) = x
 getAt! (S k) (x :: xs) = getAt! k xs
+
+
+instance ∀ a. Applicative (Either a) where
+  return b = Right b
+  Right x <*> Right y = Right (x y)
+  Left x <*> _ = Left x
+  Right x <*> Left y = Left y
+
+instance ∀ a. Monad (Either a) where
+  pure x = Right x
+  bind (Right x) mab = mab x
+  bind (Left x) mab = Left x
+
+instance Monad Maybe where
+  pure x = Just x
+  bind Nothing mab = Nothing
+  bind (Just x) mab = mab x
+
+
+elem : ∀ a. {{Eq a}} → a → List a → Bool
+elem v Nil = False
+elem v (x :: xs) = if v == x then True else elem v xs
+
+-- TODO no empty value on my `Add`, I need a group..
+-- sum : ∀ a. {{Add a}} → List a → a
+-- sum xs = foldl _+_
+pfunc trace uses (debugStr) : ∀ a. String -> a -> a := `(_, msg, a) => { console.log(msg,debugStr(_,a)); return a }`

aoc2023/day4/eg.txt

@@ -0,0 +1,6 @@
+Card 1: 41 48 83 86 17 | 83 86  6 31 17  9 48 53
+Card 2: 13 32 20 16 61 | 61 30 68 82 17 32 24 19
+Card 3:  1 21 53 59 44 | 69 82 63 72 16 21 14  1
+Card 4: 41 92 73 84 69 | 59 84 76 51 58  5 54 83
+Card 5: 87 83 26 28 32 | 88 30 70 12 93 22 82 36
+Card 6: 31 18 13 56 72 | 74 77 10 23 35 67 36 11