From 3cf311b1af020ce3bcf16b6f826d628dee8fc83d Mon Sep 17 00:00:00 2001 From: Amneesh Singh Date: Fri, 9 Dec 2022 22:32:17 +0530 Subject: [PATCH] day 8: rewrite trying a new approach hinted by someone else Signed-off-by: Amneesh Singh --- day8.hs | 80 +++++++++++++++++++++++++++------------------------------ 1 file changed, 38 insertions(+), 42 deletions(-) diff --git a/day8.hs b/day8.hs index be5c322..3ec2bce 100644 --- a/day8.hs +++ b/day8.hs @@ -1,52 +1,48 @@ -import Data.Char (digitToInt) -import Data.List (transpose, zip4, zipWith4) +import Data.List (scanl, tails, 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" - let (e, w, n, s) = trees input - let obscured = zipWith4 zip4 e w n s + input <- map T.unpack . T.lines <$> readFile' "day8.in" putStr "Q1: " - print $ - length $ - filter - (not . (\((w, _), (x, _), (y, _), (z, _)) -> w && y && x && z)) - $ concat obscured + print $ q1 input putStr "Q2: " - print $ - maximum $ - map (\((_, w), (_, x), (_, y), (_, z)) -> w * x * y * z) $ - concat obscured + print $ q2 input -type Forest = [[(Bool, Int)]] - -trees :: [[Int]] -> (Forest, Forest, Forest, Forest) -trees input = - ( trees' input, - map reverse $ trees' $ map reverse input, - transpose $ trees' $ transpose input, - reverse $ transpose $ trees' $ transpose $ reverse input - ) -- (east, west, north, south) traversals +layer :: [[Char]] -> (a -> a -> a) -> ([[Char]] -> [[a]]) -> [[a]] +layer input f f' = + zipWith4 ( zipWith4 (\w x y z -> f w . f x $ f y z) ) + (f' e) + (map reverse $ f' w) + (transpose $ f' n) + (reverse . transpose $ f' s) where - trees' :: [[Int]] -> Forest - trees' = - foldr - ( \x xs -> - let (_, dist) = - foldr - ( \(cur, y) ((old, m), ys) -> - ( if y > m then (cur, y) else (old, m), - ( y <= m, - let s = length $ takeWhile (< y) $ reverse $ take cur x - in if s == cur then s else s + 1 - ) : - ys - ) - ) - ((-1, -1), []) - (zip [0 ..] x) - in dist : xs + (e, w, n, s) = + ( input, + map reverse input, + transpose input, + transpose $ reverse input + ) -- (east, west, north, south] + +q1 :: [[Char]] -> Int +q1 input = length . filter not . concat $ layer input (&&) q1' + where + q1' :: [[Char]] -> [[Bool]] + q1' = map (\x -> zipWith (<=) x $ scanl max minBound x) + +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 + ] ) - []