Done day 8
[advent-of-code-22.git] / advent08 / Main.hs
1 -- Writeup at https://work.njae.me.uk/2022/12/07/advent-of-code-2022-day-7/
2
3 import AoC
4 -- import Data.Char
5 import Data.List
6
7
8 data Tree = Tree Int Bool -- height, isVisible
9 deriving (Show, Eq)
10 type Forest = [[Tree]]
11
12 main :: IO ()
13 main =
14 do dataFileName <- getDataFileName
15 text <- readFile dataFileName
16 let forest = fmap (fmap readTree) $ lines text
17 -- print forest
18 -- print $ findVisibilityOrient forest
19 -- print $ findVisibilityForest forest
20 -- print $ countVisible $ findVisibilityForest forest
21 print $ part1 forest
22 print $ part2 forest
23 -- print $ part1 sizedTree
24 -- print $ part2 sizedTree
25
26 part1 :: Forest -> Int
27 part1 = countVisible . findVisibilityForest
28 -- part1, part2 :: STree -> Integer
29 -- part1 = foldTree (\x xs -> sum (x:xs)) . fmap cancelLarge
30
31 readTree :: Char -> Tree
32 readTree h = Tree (read [h]) False
33
34 findVisibility :: [Tree] -> [Tree]
35 findVisibility row = snd $ foldl' vis (-1, []) row
36 where vis (highest, tagged) (Tree height visible)
37 | height > highest = (height, tagged ++ [Tree height True])
38 | otherwise = (highest, tagged ++ [Tree height visible])
39
40 findVisibilityOrient :: Forest -> Forest
41 findVisibilityOrient = fmap findVisibility
42
43 findVisibilityForest :: Forest -> Forest
44 findVisibilityForest forest = foldl' f forest [1..4]
45 where f trees _ = findVisibilityOrient (rotate trees)
46 rotate = (fmap reverse) . transpose
47
48 countVisible :: Forest -> Int
49 countVisible forest = length $ filter isVisible $ foldl' (++) [] forest
50
51 isVisible :: Tree -> Bool
52 isVisible (Tree _ v) = v
53
54 treeHeight :: Tree -> Int
55 treeHeight (Tree h _) = h
56
57 part2 :: Forest -> Int
58 part2 forest = maximum scores
59 where nrows = length forest
60 ncols = length $ head forest
61 scores = [scenicScore forest r c | r <- [0 .. (nrows - 1)], c <- [0 .. (ncols - 1)]]
62
63 viewDistance :: Int -> [Tree] -> Int
64 viewDistance h trees = length $ takeUntil (< h) $ fmap treeHeight trees
65
66 takeUntil :: (a -> Bool) -> [a] -> [a]
67 takeUntil f [] = []
68 takeUntil f (x:xs)
69 | f x == True = x : (takeUntil f xs)
70 | otherwise = [x]
71
72 tracks :: Forest -> Int -> Int -> [[Tree]]
73 tracks forest row col = [reverse l, drop 1 r, reverse u, drop 1 d]
74 where (l, r) = splitAt col (forest !! row)
75 -- r = drop 1 r'
76 (u, d) = splitAt row ((transpose forest) !! col)
77 -- d = drop 1 d'
78
79 scenicScore :: Forest -> Int -> Int -> Int
80 scenicScore forest row col = foldl' (*) 1 $ fmap (viewDistance h) directions
81 where directions = tracks forest row col
82 h = treeHeight $ (forest!!row)!!col
83