Done day 8

[advent-of-code-22.git] / advent08 / Main.hs

diff --git a/advent08/Main.hs b/advent08/Main.hs
new file mode 100644 (file)
index 0000000..12f0b21
--- /dev/null
+++ b/advent08/Main.hs
@@ -0,0 +1,83 @@
+-- Writeup at https://work.njae.me.uk/2022/12/07/advent-of-code-2022-day-7/
+
+import AoC
+-- import Data.Char
+import Data.List
+
+
+data Tree = Tree Int Bool -- height, isVisible
+  deriving (Show, Eq)
+type Forest = [[Tree]]
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let forest = fmap (fmap readTree) $ lines text
+      -- print forest
+      -- print $ findVisibilityOrient forest
+      -- print $ findVisibilityForest forest
+      -- print $ countVisible $ findVisibilityForest forest
+      print $ part1 forest
+      print $ part2 forest
+      -- print $ part1 sizedTree
+      -- print $ part2 sizedTree
+
+part1 :: Forest -> Int
+part1 = countVisible . findVisibilityForest
+-- part1, part2 :: STree -> Integer
+-- part1 = foldTree (\x xs -> sum (x:xs)) . fmap cancelLarge 
+
+readTree :: Char -> Tree
+readTree h = Tree (read [h]) False
+
+findVisibility :: [Tree] -> [Tree]
+findVisibility row = snd $ foldl' vis (-1, []) row
+  where vis (highest, tagged) (Tree height visible)
+          | height > highest = (height, tagged ++ [Tree height True])
+          | otherwise = (highest, tagged ++ [Tree height visible])
+
+findVisibilityOrient :: Forest -> Forest
+findVisibilityOrient = fmap findVisibility
+
+findVisibilityForest :: Forest -> Forest
+findVisibilityForest forest = foldl' f forest [1..4]
+  where f trees _ = findVisibilityOrient (rotate trees)
+        rotate = (fmap reverse) . transpose 
+
+countVisible :: Forest -> Int
+countVisible forest = length $ filter isVisible $ foldl' (++) [] forest
+
+isVisible :: Tree -> Bool
+isVisible (Tree _ v) = v
+
+treeHeight :: Tree -> Int
+treeHeight (Tree h _) = h
+
+part2 :: Forest -> Int
+part2 forest = maximum scores
+  where nrows = length forest
+        ncols = length $ head forest
+        scores = [scenicScore forest r c | r <- [0 .. (nrows - 1)], c <- [0 .. (ncols - 1)]]
+
+viewDistance :: Int -> [Tree] -> Int
+viewDistance h trees = length $ takeUntil (< h) $ fmap treeHeight trees
+
+takeUntil :: (a -> Bool) -> [a] -> [a]
+takeUntil f [] = []
+takeUntil f (x:xs) 
+  | f x == True = x : (takeUntil f xs)
+  | otherwise = [x]
+
+tracks :: Forest -> Int -> Int -> [[Tree]]
+tracks forest row col = [reverse l, drop 1 r, reverse u, drop 1 d]
+  where (l, r) = splitAt col (forest !! row)
+        -- r = drop 1 r'
+        (u, d) = splitAt row ((transpose forest) !! col)
+        -- d = drop 1 d'
+
+scenicScore :: Forest -> Int -> Int -> Int
+scenicScore forest row col = foldl' (*) 1 $ fmap (viewDistance h) directions
+  where directions = tracks forest row col
+        h = treeHeight $ (forest!!row)!!col
+