diff --git a/aoc2024/Day12.newt b/aoc2024/Day12.newt new file mode 100644 index 0000000..9982abb --- /dev/null +++ b/aoc2024/Day12.newt @@ -0,0 +1,115 @@ +module Day12 + +import Prelude +import Node +import Aoc +import SortedMap + +-- move to lib + +gridPoints : String → List (Char × Int × Int) +gridPoints text = go 0 0 (unpack text) Nil + where + -- might as well be tail recursive + go : Int → Int → List Char → List (Char × Int × Int) → List (Char × Int × Int) + go row col Nil points = points + go row col ('\n' :: cs) points = go (row + 1) 0 cs points + go row col (c :: cs) points = go row (col + 1) cs ((c,row,col) :: points) + +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) + +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 + +-- TODO add parameter a and pass Char -> a into getGrid +Grid : U +Grid = SortedMap Point Int + +digitToInt : Char → Int +digitToInt c = ord c + +getGrid : String → Grid + +getGrid text = foldl update EmptyMap $ gridPoints text + where + update : Grid → Char × Point → Grid + update grid (c,pt) = updateMap pt (digitToInt c) grid + +north east south west : Point +north = (0, 0 - 1) +south = (0, 1) +east = (1, 0) +west = (0 - 1, 0) + + +neighbors : Point → List Point +neighbors pt = map (_+_ pt) ((0, 0 - 1) :: (0,1) :: (0 - 1,0) :: (1,0) :: Nil) + + +perim2 : Grid → Point → Int → Int +perim2 grid pt color = + let top = different (north + pt) && (different (west + pt) || same (west + north + pt)) + bottom = different (south + pt) && (different (west + pt) || same (west + south + pt)) + left = different (west + pt) && (different (north + pt) || same (north + west + pt)) + right = different (east + pt) && (different (north + pt) || same (north + east + pt)) + in (ite top 1 0) + (ite bottom 1 0) + ite left 1 0 + ite right 1 0 + where + same : Point → Bool + same pt = case lookupMap pt grid of + Just (_, c) => c == color + Nothing => False + different : Point → Bool + different pt = not $ same pt + +-- use negative numbers for the regions we've filled +flood : Grid → Point → Int → Maybe (Int × Int × Grid) +flood orig start id = + let (Just (pt,color)) = lookupMap start orig | Nothing => Nothing in + if 0 < color then Just $ go orig color (start :: Nil) 0 0 0 else Nothing + where + go : Grid → Int → List Point → Int → Int → Int → Int × Int × Grid + go grid' color Nil area perim p2 = ((area * perim), (area * p2), grid') + go grid' color (pt :: pts) area perim p2 = + let (Just (_,c2)) = lookupMap pt grid' | Nothing => go grid' color pts area perim p2 in + if c2 /= color then go grid' color pts area perim p2 else + let next = map fst $ filter (_==_ color ∘ snd) $ mapMaybe (flip lookupMap orig) $ neighbors pt + perim = perim + 4 - cast (length next) + p2 = p2 + perim2 orig pt color + grid = updateMap pt id grid' + in go grid color (next ++ pts) (area + 1) perim p2 + + +part1 : Grid → Int × Int +part1 grid = go grid (0 - 1) (map fst $ toList grid) 0 0 + where + go : Grid → Int → List Point → Int → Int → Int × Int + go grid id Nil acc acc2 = (acc, acc2) + go grid id (pt :: pts) acc acc2 = + case flood grid pt id of + Nothing => go grid id pts acc acc2 + Just (cost, cost2, grid) => go grid (id - 1) pts (acc + cost) (acc2 + cost2) + +run : String -> IO Unit +run fn = do + putStrLn fn + text <- readFile fn + let grid = getGrid text + let (p1, p2) = part1 grid + putStrLn $ "part1 " ++ show p1 + putStrLn $ "part2 " ++ show p2 + +main : IO Unit +main = do + run "aoc2024/day12/eg.txt" + run "aoc2024/day12/eg2.txt" + run "aoc2024/day12/input.txt" diff --git a/aoc2024/day12/eg.txt b/aoc2024/day12/eg.txt new file mode 100644 index 0000000..b41163a --- /dev/null +++ b/aoc2024/day12/eg.txt @@ -0,0 +1,4 @@ +AAAA +BBCD +BBCC +EEEC diff --git a/aoc2024/day12/eg2.txt b/aoc2024/day12/eg2.txt new file mode 100644 index 0000000..cc213c5 --- /dev/null +++ b/aoc2024/day12/eg2.txt @@ -0,0 +1,5 @@ +OOOOO +OXOXO +OOOOO +OXOXO +OOOOO \ No newline at end of file diff --git a/aoc2024/day12/eg3.txt b/aoc2024/day12/eg3.txt new file mode 100644 index 0000000..0b328f1 --- /dev/null +++ b/aoc2024/day12/eg3.txt @@ -0,0 +1,10 @@ +RRRRIICCFF +RRRRIICCCF +VVRRRCCFFF +VVRCCCJFFF +VVVVCJJCFE +VVIVCCJJEE +VVIIICJJEE +MIIIIIJJEE +MIIISIJEEE +MMMISSJEEE \ No newline at end of file diff --git a/newt/Prelude.newt b/newt/Prelude.newt index 19d40d8..2427780 100644 --- a/newt/Prelude.newt +++ b/newt/Prelude.newt @@ -137,9 +137,21 @@ instance Functor Maybe where map f Nothing = Nothing map f (Just a) = Just (f a) +reverse : ∀ a. List a → List a +reverse {a} = go Nil + where + go : List a → List a → List a + go acc Nil = acc + go acc (x :: xs) = go (x :: acc) xs + instance Functor List where - map f Nil = Nil - map f (x :: xs) = f x :: map f xs + map f xs = go f xs Nil + where + go : ∀ a b. (a → b) → List a → List b → List b + go f Nil ys = reverse ys + go f (x :: xs) ys = go f xs (f x :: ys) + -- map f Nil = Nil + -- map f (x :: xs) = f x :: map f xs instance Functor SnocList where map f Lin = Lin @@ -463,12 +475,6 @@ printLn a = putStrLn (show a) -- opaque JSObject ptype JSObject -reverse : ∀ a. List a → List a -reverse {a} = go Nil - where - go : List a → List a → List a - go acc Nil = acc - go acc (x :: xs) = go (x :: acc) xs -- Like Idris1, but not idris2, we need {a} to put a in scope. span : ∀ a. (a -> Bool) -> List a -> List a × List a