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