day 6

.gitignore

@@ -1 +1,2 @@
 **/input.txt
+6/day-six

6/example.txt

@@ -0,0 +1,10 @@
+....#.....
+.........#
+..........
+..#.......
+.......#..
+..........
+.#..^.....
+........#.
+#.........
+......#...

6/solution.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE DeriveGeneric #-}
+import Data.List
+import Data.Maybe
+import Debug.Trace
+import Data.Containers.ListUtils
+import Control.Parallel.Strategies
+
+import GHC.Generics (Generic)
+
+addFirst :: [[a]] -> a -> [[a]]
+addFirst [] x = [[x]]
+addFirst (y:ys) x = ([x] ++ y) : ys
+
+split :: [Char] -> String -> [String]
+split _ [] = []
+split delims (x:xs)
+  | elem x delims = [[]] ++ split delims xs
+  | otherwise     = addFirst (split delims xs) x
+
+splitInput :: String -> BoardState
+splitInput text = (\x -> Board (getObstacles x 0) (fromJust $ getGuard x 0) North [] (length x, length (x!!0))) $ split ['\n'] text
+
+getGuard :: [String] -> Int -> Maybe (Int, Int)
+getGuard [] _ = Nothing
+getGuard (x:xs) y
+  | elem '^' x = Just (y, fromJust $ elemIndex '^' x)
+  | otherwise  = getGuard xs (y+1)
+
+getObstacles :: [String] -> Int -> [(Int, Int)]
+getObstacles [] _ = []
+getObstacles (x:xs) y = (map (\x -> (y, x)) $ elemIndices '#' x) ++ (getObstacles xs (y+1))
+
+data Direction = North | East | South | West deriving (Show, Eq, Generic)
+
+instance NFData Direction
+
+-- coordinates of obstacles,
+-- position of guard,
+-- direction of guard,
+-- history of guard,
+-- size of grid.
+data BoardState = Board [(Int, Int)] (Int, Int) Direction [((Int, Int), Direction)] (Int, Int) deriving Show
+
+increment :: Direction -> Direction
+increment North = East
+increment East = South
+increment South = West
+increment West = North
+
+addCoords :: Num a => (a, a) -> (a, a) -> (a, a)
+addCoords (a, b) (c, d) = (a+c, b+d)
+
+checkBounds :: (Num a, Ord a) => (a, a) -> (a, a) -> Bool
+checkBounds (a, b) (c, d) = (0 <= a) && (0 <= b) && (a < c) && (b < d)
+
+step :: Direction -> (Int, Int)
+step North = (-1, 0)
+step East = (0, 1)
+step South = (1, 0)
+step West = (0, -1)
+
+count :: Eq a => a -> [a] -> Int
+count x y = length $ filter (==x) y
+
+solve1 :: BoardState -> Int
+solve1 x = length $ getHistNub x
+
+getHist :: BoardState -> Maybe [((Int, Int), Direction)]
+getHist (Board obstacles pos dir hist size)
+  | not (checkBounds pos size)                      = Just hist
+  | elem (pos, dir) hist                            = Nothing
+  | not (elem (addCoords pos (step dir)) obstacles) = getHist (Board obstacles (addCoords pos (step dir)) dir ((pos, dir):hist) size)
+  | otherwise                                       = getHist (Board obstacles pos (increment dir) hist size)
+
+getHistNub :: BoardState -> [((Int, Int), Direction)]
+getHistNub x = nubOrdOn (\(a, _) -> a) $ fromJust $ getHist x
+
+solve2 :: BoardState -> Int
+solve2 (Board obstacles pos dir hist size) = count Nothing $ ((map (\x -> getHist x) $ map (\(x, y) -> (Board (x:obstacles) pos dir hist size)) $ drop 1 $ getHistNub (Board obstacles pos dir hist size)) `using` parListChunk 64 rdeepseq)
+
+main :: IO()
+main = do
+       fileinp <- readFile "input.txt"
+       let parsed = splitInput fileinp
+       let solved1 = solve1 parsed
+       let solved2 = solve2 parsed
+       print solved1
+       print solved2