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