advent08/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2022/12/08/advent-of-code-2022-day-8/
   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 $ part1 forest
  18       print $ part2 forest
  19
  20 part1, part2 :: Forest -> Int
  21 part1 = countVisible . setVisibilityForest
  22
  23 part2 forest = maximum scores
  24   where nrows = length forest
  25         ncols = length $ head forest
  26         scores = [scenicScore forest r c | r <- [0 .. (nrows - 1)], c <- [0 .. (ncols - 1)]]
  27
  28
  29 readTree :: Char -> Tree
  30 readTree h = Tree (read [h]) False
  31
  32 isVisible :: Tree -> Bool
  33 isVisible (Tree _ v) = v
  34
  35 treeHeight :: Tree -> Int
  36 treeHeight (Tree h _) = h
  37
  38
  39 setVisibility :: [Tree] -> [Tree]
  40 setVisibility row = reverse $ snd $ foldl' vis (-1, []) row
  41   where vis (highest, tagged) (Tree height visible)
  42           | height > highest = (height, (Tree height True) : tagged)
  43           | otherwise = (highest, (Tree height visible) : tagged)
  44
  45 setVisibilityOrient :: Forest -> Forest
  46 setVisibilityOrient = fmap setVisibility
  47
  48 setVisibilityForest :: Forest -> Forest
  49 setVisibilityForest forest = (!!4) $ iterate f forest
  50   where f = rotate . setVisibilityOrient
  51         rotate = (fmap reverse) . transpose
  52
  53 countVisible :: Forest -> Int
  54 countVisible forest = length $ filter isVisible $ concat forest
  55
  56
  57
  58 viewDistance :: Int -> [Tree] -> Int
  59 viewDistance h trees = length $ takeWhile1 (< h) $ fmap treeHeight trees
  60
  61 takeWhile1 :: (a -> Bool) -> [a] -> [a]
  62 takeWhile1 _ [] = []
  63 takeWhile1 f (x:xs)
  64   | f x == True = x : (takeWhile1 f xs)
  65   | otherwise = [x]
  66
  67 tracks :: Forest -> Int -> Int -> [[Tree]]
  68 tracks forest row col = [reverse l, drop 1 r, reverse u, drop 1 d]
  69   where (l, r) = splitAt col (forest !! row)
  70         (u, d) = splitAt row ((transpose forest) !! col)
  71
  72 scenicScore :: Forest -> Int -> Int -> Int
  73 scenicScore forest row col = foldl' (*) 1 $ fmap (viewDistance h) directions
  74   where directions = tracks forest row col
  75         h = treeHeight $ (forest!!row)!!col
  76