day8

day8/main.hs

@@ -0,0 +1,79 @@
+import System.IO
+
+import Data.List
+import Data.List.Split
+
+
+parseForest :: String -> [[Int]]
+parseForest = map (\ r -> map toInt r) . lines
+    where toInt = (\ c -> read [c] :: Int)
+
+
+rotateForest :: Int -> [[a]] -> [[a]]
+rotateForest 0 f = f
+rotateForest 1 f = transpose f
+rotateForest 2 f = map reverse f
+rotateForest 3 f = map reverse $ transpose f
+
+rotateForestBack 3 f = transpose $ map reverse f
+rotateForestBack n f = rotateForest n f
+
+
+
+
+visibilityRow :: Int -> [Int] -> [Bool]
+visibilityRow _ [] = []
+visibilityRow m (x:xs)
+    | x == 9    = (True:[False | _ <- xs])
+    | x > m     = (True:visibilityRow x xs)
+    | otherwise = (False:visibilityRow m xs)
+
+
+visibilityMap :: [[Int]] -> [[Bool]]
+visibilityMap = map (visibilityRow (-1))
+
+
+
+
+merge' :: (a -> a -> a) -> [[[a]]] -> [[a]]
+merge' f = foldl1 (zipWith (zipWith f))
+
+merge :: (a -> a -> a) -> [[[a]]] -> [[a]]
+merge f m = merge' f $ zipWith rotateForestBack [0..length m] m
+
+count :: [[Bool]] -> Int
+count = length . filter (==True) . concat
+
+
+
+
+hv :: [[Int]] -> Int
+hv [left,[c],right] = (v $ reverse left) * (v right)
+    where
+        v [] = 0
+        v (x:xs)
+            | x >= c = 1
+            | otherwise = 1 + (v xs)
+
+
+hvm :: [[Int]] -> [[Int]]
+hvm = map (map hv . splits)
+    where
+        splits a = map (\n -> splitPlacesBlanks [n,1,length a] a) [0..length a-1]
+
+
+
+
+handler :: String -> String
+handler s = (show visibleTrees) ++ "\n" ++
+            (show hvs) ++ "\n"
+    where
+        f = parseForest s
+        dirs = map (\ x -> rotateForest x f) [0..3]
+        visibleTrees = count $ merge (||) $ map visibilityMap dirs
+        hvs = maximum $ concat $ merge (*) $ map hvm (take 2 dirs)
+
+
+main :: IO ()
+main = do
+    interact handler