Day4.hs (6946B)
1 module Day4 (solution) where 2 3 import Utils (SolType(..)) 4 5 import qualified Data.List ((!?)) 6 import Data.List (foldl') 7 import Data.Vector (Vector, (!?), fromList) 8 import qualified Data.Vector (length) 9 import Control.Monad (liftM, join) 10 import GHC.Num (integerFromInt) 11 import Debug.Trace (trace) 12 13 vecLen :: Vector a -> Int 14 vecLen = Data.Vector.length 15 16 input :: IO String 17 input = readFile "inputs/day4" 18 19 exampleInput :: String 20 exampleInput = join 21 [ "MMMSXXMASM\n" 22 , "MSAMXMSMSA\n" 23 , "AMXSXMAAMM\n" 24 , "MSAMASMSMX\n" 25 , "XMASAMXAMM\n" 26 , "XXAMMXXAMA\n" 27 , "SMSMSASXSS\n" 28 , "SAXAMASAAA\n" 29 , "MAMMMXMMMM\n" 30 , "MXMXAXMASX\n" 31 ] 32 33 -- | Parse the input string into a 2D array of characters 34 parse :: String -> Vector (Vector Char) 35 parse = fromList . (map fromList) . lines 36 37 -- | Find the position of every c within a 2D array 38 findCharCoords :: Char -> Vector (Vector Char) -> [(Int, Int)] 39 findCharCoords c vs = case vs !? 0 of 40 Just v -> helper (vecLen v, vecLen vs) (0,0) 41 Nothing -> [] 42 where 43 helper :: (Int, Int) -> (Int, Int) -> [(Int, Int)] 44 helper (lx, ly) (a, b) = case liftM ((==) c) $ vs !? b >>= (flip (!?) a) of 45 Just True -> (a, b) : next 46 _ -> next 47 where 48 next :: [(Int, Int)] 49 next = if newY < ly then helper (lx, ly) (newX, newY) else [] 50 newX :: Int 51 newX = (a + 1) `rem` lx 52 newY :: Int 53 newY = (lx * b + a + 1) `quot` lx 54 55 -- | Find every 'X' character in the 2D array of chars 56 -- Example: 57 -- >>> findXs $ parse exampleInput 58 -- [(4,0),(5,0),(4,1),(2,2),(4,2),(9,3),(0,4),(6,4),(0,5),(1,5),(5,5),(6,5),(7,6),(2,7),(5,8),(1,9),(3,9),(5,9),(9,9)] 59 findXs :: Vector (Vector Char) -> [(Int, Int)] 60 findXs = findCharCoords 'X' 61 {- 62 findXs :: Vector (Vector Char) -> [(Int, Int)] 63 findXs vs = case vs !? 0 of 64 Just v -> helper (vecLen v, vecLen vs) (0,0) 65 Nothing -> [] 66 where 67 helper :: (Int, Int) -> (Int, Int) -> [(Int, Int)] 68 helper (lx, ly) (a, b) = case vs !? b >>= (flip (!?) a) of 69 Just 'X' -> (a, b) : next 70 _ -> next 71 where 72 next :: [(Int, Int)] 73 next = if newY < ly then helper (lx, ly) (newX, newY) else [] 74 newX :: Int 75 newX = (a + 1) `rem` lx 76 newY :: Int 77 newY = (lx * b + a + 1) `quot` lx 78 -} 79 80 -- | Find every path of a given length from a starting point 81 -- Example: 82 -- >>> findWordPaths 2 (0,0) 83 -- [[(0,0),(-1,-1)],[(0,0),(-1,0)],[(0,0),(-1,1)],[(0,0),(0,-1)],[(0,0),(0,1)],[(0,0),(1,-1)],[(0,0),(1,0)],[(0,0),(1,1)]] 84 -- >>> findWordPaths 3 (0,0) 85 -- [[(0,0),(-1,-1),(-2,-2)],[(0,0),(-1,0),(-2,0)],[(0,0),(-1,1),(-2,2)],[(0,0),(0,-1),(0,-2)],[(0,0),(0,1),(0,2)],[(0,0),(1,-1),(2,-2)],[(0,0),(1,0),(2,0)],[(0,0),(1,1),(2,2)]] 86 -- >>> findWordPaths 2 (6,9) 87 -- [[(6,9),(5,8)],[(6,9),(5,9)],[(6,9),(5,10)],[(6,9),(6,8)],[(6,9),(6,10)],[(6,9),(7,8)],[(6,9),(7,9)],[(6,9),(7,10)]] 88 findWordPaths :: Int -> (Int, Int) -> [[(Int, Int)]] 89 findWordPaths len (x, y) = 90 [helper len (-1,-1), helper len (-1, 0), helper len (-1, 1), helper len (0, -1), helper len (0, 1), helper len (1, -1), helper len (1, 0), helper len (1, 1)] 91 where 92 helper :: Int -> (Int, Int) -> [(Int, Int)] 93 helper c (vx, vy) 94 | c > 0 = (x + vx * (len - c), y + vy * (len - c)) : helper (c - 1) (vx, vy) 95 | otherwise = [] 96 97 {- 98 validPath :: (Int, Int) -> [(Int, Int)] -> Bool 99 validPath dims@(maxX, maxY) ((x, y) : ps) 100 = x >= 0 && x < maxX && y >= 0 && y < maxY && validPath dims ps 101 validPath _ [] = True 102 103 filterWordPaths :: (Int, Int) -> [[(Int, Int)]] -> [[(Int, Int)]] 104 filterWordPaths (maxX, maxY) = filter (validPath (maxX, maxY)) 105 -} 106 107 -- | Find the number of instances of XMAS for each 'X' 108 -- Example: 109 -- >>> filter (\x -> x /= 0) $ let vs = parse exampleInput in (findXmasCounts vs $ findXs vs) 110 -- [1,1,1,2,1,2,1,1,1,2,3,2] 111 findXmasCounts :: Vector (Vector Char) -> [(Int, Int)] -> [Int] 112 findXmasCounts vs ((x, y) : rest) = (helper $ findWordPaths 4 (x, y)) : findXmasCounts vs rest 113 where 114 helper :: [[(Int, Int)]] -> Int 115 helper (p:ps) 116 | xmasPath 0 p = 1 + helper ps 117 | otherwise = helper ps 118 helper [] = 0 119 xmasPath :: Int -> [(Int, Int)] -> Bool 120 xmasPath n ((a, b) : ps) = case (vs !? b >>= (flip (!?) a), xmasStr Data.List.!? n) of 121 (Just val, Just expected) -> val == expected && xmasPath (n+1) ps 122 _ -> False 123 xmasPath _ [] = True 124 xmasStr :: String 125 xmasStr = "XMAS" 126 findXmasCounts _ [] = [] 127 128 -- | Solution to day 4 part 1 129 -- Example: 130 -- >>> solution1 $ parse exampleInput 131 -- 18 132 solution1 :: Vector (Vector Char) -> Int 133 solution1 vs = foldl' (+) 0 $ findXmasCounts vs $ findXs vs 134 135 -- | Find every 'A' character in the 2D array of chars 136 -- Example: 137 -- >>> findAs $ parse exampleInput 138 -- [(7,0),(2,1),(9,1),(0,2),(6,2),(7,2),(2,3),(4,3),(2,4),(4,4),(7,4),(2,5),(7,5),(9,5),(5,6),(1,7),(3,7),(5,7),(7,7),(8,7),(9,7),(1,8),(4,9),(7,9)] 139 findAs :: Vector (Vector Char) -> [(Int, Int)] 140 findAs = findCharCoords 'A' 141 142 -- | Find all possible diagonals of length 3 with the middle at a given point. 143 -- Example: 144 -- >>> findCrossPaths (0,0) 145 -- [[(1,1),(0,0),(-1,-1)],[(1,-1),(0,0),(-1,1)],[(-1,1),(0,0),(1,-1)],[(-1,-1),(0,0),(1,1)]] 146 -- >>> findCrossPaths (6,9) 147 -- [[(7,10),(6,9),(5,8)],[(7,8),(6,9),(5,10)],[(5,10),(6,9),(7,8)],[(5,8),(6,9),(7,10)]] 148 findCrossPaths :: (Int,Int) -> [[(Int, Int)]] 149 findCrossPaths (x, y) = [helper 0 (-1,-1), helper 0 (-1,1), helper 0 (1, -1), helper 0 (1,1)] 150 where 151 helper :: Int -> (Int, Int) -> [(Int, Int)] 152 helper c (vx, vy) 153 | c == 3 = [] 154 | otherwise = (x + vx * (c - 1), y + vy * (c - 1)) : helper (c+1) (vx, vy) 155 156 -- | Find the number of diagonal "MAS" for each 'A'. Any 'A's with 2 diagonals 157 -- form a crossed "MAS", and so an X-MAS in part 2 158 -- Example: 159 -- >>> let vs = parse exampleInput in (findCrossedMasses vs $ findAs vs) 160 -- [0,2,0,0,2,2,2,2,1,1,0,1,1,0,1,2,2,2,2,1,0,1,0,0] 161 findCrossedMasses :: Vector (Vector Char) -> [(Int, Int)] -> [Int] 162 findCrossedMasses vs ((x, y) : rest) = (helper $ findCrossPaths (x, y)) : findCrossedMasses vs rest 163 where 164 helper :: [[(Int, Int)]] -> Int 165 helper (p:ps) 166 | masPath 0 p = 1 + helper ps 167 | otherwise = helper ps 168 helper [] = 0 169 masPath :: Int -> [(Int, Int)] -> Bool 170 masPath n ((a, b) : ps) = case (vs !? b >>= (flip (!?) a), masStr Data.List.!? n) of 171 (Just val, Just expected) -> val == expected && masPath (n+1) ps 172 _ -> False 173 masPath _ [] = True 174 masStr :: String 175 masStr = "MAS" 176 findCrossedMasses _ [] = [] 177 178 -- | Solution to day 4 part 2 179 -- Example: 180 -- >>> solution2 $ parse exampleInput 181 -- 9 182 solution2 :: Vector (Vector Char) -> Int 183 solution2 vs = length $ filter (\x -> x == 2) $ findCrossedMasses vs $ findAs vs 184 185 solution :: IO (SolType, SolType) 186 solution = do 187 inputVec <- liftM parse input 188 let sol1 = integerFromInt $ solution1 inputVec 189 let sol2 = integerFromInt $ solution2 inputVec 190 return (IntSol sol1, IntSol sol2)