From 0f5a909cce2ac0e795c00c4d37669de5f483c5ab Mon Sep 17 00:00:00 2001 From: Steve Dunham Date: Sat, 7 Dec 2024 22:12:38 -0800 Subject: [PATCH] day8 --- aoc2024/Day8.newt | 95 +++++++++++++++++++++++++++++++++++++++++++++ aoc2024/day8/eg.txt | 12 ++++++ newt/Prelude.newt | 3 ++ 3 files changed, 110 insertions(+) create mode 100644 aoc2024/Day8.newt create mode 100644 aoc2024/day8/eg.txt diff --git a/aoc2024/Day8.newt b/aoc2024/Day8.newt new file mode 100644 index 0000000..6215b12 --- /dev/null +++ b/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" diff --git a/aoc2024/day8/eg.txt b/aoc2024/day8/eg.txt new file mode 100644 index 0000000..78a1e91 --- /dev/null +++ b/aoc2024/day8/eg.txt @@ -0,0 +1,12 @@ +............ +........0... +.....0...... +.......0.... +....0....... +......A..... +............ +............ +........A... +.........A.. +............ +............ diff --git a/newt/Prelude.newt b/newt/Prelude.newt index 78ace48..35f73f8 100644 --- a/newt/Prelude.newt +++ b/newt/Prelude.newt @@ -647,6 +647,9 @@ instance Ord Int where -- isEq = ? x < y = ltInt x y +instance Ord Char where + x < y = jsLT x y + -- foo : ∀ a. {{Ord a}} -> a -> Bool -- foo a = a == a