day 8: rewrite

trying a new approach hinted by someone else

Signed-off-by: Amneesh Singh <natto@weirdnatto.in>

day8.hs

@@ -1,52 +1,48 @@
-import Data.Char (digitToInt)
+import Data.List (scanl, tails, transpose, zip4, zipWith4)
-import Data.List (transpose, zip4, zipWith4)
+import Data.Text (Text)
+import qualified Data.Text as T (lines, unpack)
+import Lib (readFile')
 
+-- new approach was hinted by an anon but I cannot quite get it right
 -- a fun approach, not necessarily the fastest (or cleanest (or smartest))
 
 main :: IO ()
 main = do
-  input <- map (map digitToInt) . lines <$> readFile "day8.in"
+  input <- map T.unpack . T.lines <$> readFile' "day8.in"
-  let (e, w, n, s) = trees input
-  let obscured = zipWith4 zip4 e w n s
   putStr "Q1: "
-  print $
+  print $ q1 input
-    length $
-      filter
-        (not . (\((w, _), (x, _), (y, _), (z, _)) -> w && y && x && z))
-        $ concat obscured
   putStr "Q2: "
-  print $
+  print $ q2 input
-    maximum $
-      map (\((_, w), (_, x), (_, y), (_, z)) -> w * x * y * z) $
-        concat obscured
 
-type Forest = [[(Bool, Int)]]
+layer :: [[Char]] -> (a -> a -> a) -> ([[Char]] -> [[a]]) -> [[a]]
-
+layer input f f' =
-trees :: [[Int]] -> (Forest, Forest, Forest, Forest)
+  zipWith4 ( zipWith4 (\w x y z -> f w . f x $ f y z) )
-trees input =
+    (f' e)
-  ( trees' input,
+    (map reverse $ f' w)
-    map reverse $ trees' $ map reverse input,
+    (transpose $ f' n)
-    transpose $ trees' $ transpose input,
+    (reverse . transpose $ f' s)
-    reverse $ transpose $ trees' $ transpose $ reverse input
-  ) -- (east, west, north, south) traversals
   where
-    trees' :: [[Int]] -> Forest
+    (e, w, n, s) =
-    trees' =
+      ( input,
-      foldr
+        map reverse input,
-        ( \x xs ->
+        transpose input,
-            let (_, dist) =
+        transpose $ reverse input
-                  foldr
+      ) -- (east, west, north, south]
-                    ( \(cur, y) ((old, m), ys) ->
+
-                        ( if y > m then (cur, y) else (old, m),
+q1 :: [[Char]] -> Int
-                          ( y <= m,
+q1 input = length . filter not . concat $ layer input (&&) q1'
-                            let s = length $ takeWhile (< y) $ reverse $ take cur x
+  where
-                             in if s == cur then s else s + 1
+    q1' :: [[Char]] -> [[Bool]]
-                          ) :
+    q1' = map (\x -> zipWith (<=) x $ scanl max minBound x)
-                          ys
+
+q2 :: [[Char]] -> Int
+q2 input = maximum . concat $ layer input (*) q2'
+  where
+    q2' :: [[Char]] -> [[Int]]
+    q2' =
+      map
+        ( \a ->
+            [ let l = length (takeWhile (< x) xs) in (+ l) . fromEnum $ length xs /= l
+              | (x : xs) <- tails a
+            ]
         )
-                    )
-                    ((-1, -1), [])
-                    (zip [0 ..] x)
-             in dist : xs
-        )
-        []