diff options
Diffstat (limited to 'day-07/sol.hs')
-rw-r--r-- | day-07/sol.hs | 114 |
1 files changed, 0 insertions, 114 deletions
diff --git a/day-07/sol.hs b/day-07/sol.hs deleted file mode 100644 index c6b8c35..0000000 --- a/day-07/sol.hs +++ /dev/null @@ -1,114 +0,0 @@ -import Data.List (find, transpose) -import qualified Data.Set as Set -import qualified Data.Text as Text -import qualified Data.Text.IO as Text - -countVisibleTrees :: - [[Int]] -> [Int] -> Int -> (Set.Set (Int, Int)) -> (Set.Set (Int, Int)) -countVisibleTrees [] _ _ seen = seen -countVisibleTrees (row:rows) maxTrees depth seen = - countVisibleTrees - rows - (zipWith (\x y -> max x y) row maxTrees) - (depth + 1) - (foldl - (\acc x -> Set.insert x acc) - seen - (zipWith - (\i x -> - if x == 1 - then (depth, i) - else (0, 0)) - [0 ..] - (zipWith - (\x y -> - if x > y - then 1 - else 0) - row - maxTrees))) - -treeScore :: [[Int]] -> (Int, Int) -> Int -> Int -> [Int] -treeScore digits (x, y) width height = - let currentHeight = ((digits !! y) !! x) - in [ (case (find - (\x -> (digits !! y) !! x >= currentHeight) - [(x + 1) .. (width - 1)]) of - Just value -> (value - x) - Nothing -> (width - x - 1)) - , (case (find - (\x -> (digits !! y) !! x >= currentHeight) - (reverse [0 .. (x - 1)])) of - Just value -> (x - value) - Nothing -> x) - , (case (find - (\y -> (digits !! y) !! x >= currentHeight) - (reverse [0 .. (y - 1)])) of - Just value -> (y - value) - Nothing -> y) - , (case (find - (\y -> (digits !! y) !! x >= currentHeight) - [(y + 1) .. (height - 1)]) of - Just value -> (value - y) - Nothing -> (height - y - 1)) - ] - -getDigitsFromString :: String -> [Int] -getDigitsFromString = map (read . (: "")) - -rotl :: [[Int]] -> [[Int]] -rotl = reverse . transpose - -rotr :: [[Int]] -> [[Int]] -rotr = transpose . reverse - -main = do - ls <- fmap Text.lines (Text.readFile "input") - let digits = map (getDigitsFromString . Text.unpack) ls - let height = length digits - let width = length (head digits) - let topDownSeen = - countVisibleTrees digits (take width (repeat (-1))) 0 Set.empty - let rightLeftSeen = - Set.map - (\x -> ((snd x), width - (fst x) - 1)) - (countVisibleTrees - (rotl digits) - (take height (repeat (-1))) - 0 - Set.empty) - let downTopSeen = - Set.map - (\x -> (height - (fst x) - 1, (snd x))) - (countVisibleTrees - (reverse digits) - (take width (repeat (-1))) - 0 - Set.empty) - let leftRightSeen = - Set.map - (\x -> (height - (snd x) - 1, (fst x))) - (countVisibleTrees - (rotr digits) - (take height (repeat (-1))) - 0 - Set.empty) - let allSeen = - (foldl - (\acc x -> Set.union acc x) - Set.empty - [topDownSeen, rightLeftSeen, downTopSeen, leftRightSeen]) - print (Set.size allSeen) - print - (maximum - (map - (\y -> - maximum - (map - (\x -> - (foldl - (\acc x -> acc * x) - 1 - (treeScore digits (x, y) width height))) - [0 .. (width - 1)])) - [0 .. (height - 1)])) |