diff --git a/.gitignore b/.gitignore index cf29d46..14ab5ba 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ **/input.txt +**/input2.txt 6/day-six diff --git a/12/example.txt b/12/example.txt deleted file mode 100644 index 85b768f..0000000 --- a/12/example.txt +++ /dev/null @@ -1,10 +0,0 @@ -RRRRIICCFF -RRRRIICCCF -VVRRRCCFFF -VVRCCCJFFF -VVVVCJJCFE -VVIVCCJJEE -VVIIICJJEE -MIIIIIJJEE -MIIISIJEEE -MMMISSJEEE diff --git a/13/example.txt b/13/example.txt deleted file mode 100644 index 912f482..0000000 --- a/13/example.txt +++ /dev/null @@ -1,15 +0,0 @@ -Button A: X+94, Y+34 -Button B: X+22, Y+67 -Prize: X=8400, Y=5400 - -Button A: X+26, Y+66 -Button B: X+67, Y+21 -Prize: X=12748, Y=12176 - -Button A: X+17, Y+86 -Button B: X+84, Y+37 -Prize: X=7870, Y=6450 - -Button A: X+69, Y+23 -Button B: X+27, Y+71 -Prize: X=18641, Y=10279 diff --git a/15/solution.hs b/15/solution.hs new file mode 100644 index 0000000..1b4783d --- /dev/null +++ b/15/solution.hs @@ -0,0 +1,141 @@ +import qualified Data.List.Split as S +import Data.Maybe +import Data.List +import Data.Array +import Debug.Trace + +traceOut :: Show a => a -> a +traceOut x = (traceShow x x) + +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 + +toTuple :: [a] -> Maybe (a, a) +toTuple [] = Nothing +toTuple (_:[]) = Nothing +toTuple (x:y:_) = Just (x, y) + +data Square = Robot | Box | BoxL | BoxR | Block | Empty deriving Eq + +instance Show Square where + show x + | x == Robot = "@" + | x == Box = "O" + | x == BoxL = "[" + | x == BoxR = "]" + | x == Block = "#" + | x == Empty = "." + +toSquare :: Char -> Maybe Square +toSquare '@' = Just Robot +toSquare 'O' = Just Box +toSquare '[' = Just BoxL +toSquare ']' = Just BoxR +toSquare '#' = Just Block +toSquare '.' = Just Empty +toSquare _ = Nothing + +data Direction = DirUp | DirDown | DirLeft | DirRight deriving Eq + +instance Show Direction where + show x + | x == DirUp = "^" + | x == DirDown = "v" + | x == DirLeft = "<" + | x == DirRight = ">" + +toDirection :: Char -> Maybe Direction +toDirection '^' = Just DirUp +toDirection 'v' = Just DirDown +toDirection '<' = Just DirLeft +toDirection '>' = Just DirRight +toDirection _ = Nothing + +apply :: ((a -> b), (c -> d)) -> (a, c) -> (b, d) +apply (f, g) (x, y) = (f x, g y) + +splitInput :: [String] -> (Array (Int, Int) Square, [Direction]) +splitInput inputs = apply ((\x -> listArray ((0, 0), ((length x)-1, (length $ head x)-1)) (concat $ map (map (fromJust . toSquare)) x)) . split "\n", + map (fromJust . toDirection) . concat . split "\n" + ) $ fromJust $ toTuple inputs + +-- y -> +-- x +-- | +-- v + +getPushRow :: (Array (Int, Int) Square) -> Direction -> [(Int, Int)] +getPushRow arr dir = case dir of + DirUp -> [(x, roboty) | x <- reverse [0..robotx]] + DirDown -> [(x, roboty) | x <- [robotx..]] + DirLeft -> [(robotx, y) | y <- reverse [0..roboty]] + DirRight -> [(robotx, y) | y <- [roboty..]] + where (robotx, roboty) = (\(a, _) -> a) $ head $ filter (\(_, b) -> b==Robot) $ assocs arr + +firstWhere :: Show a => (a -> Bool) -> [a] -> Maybe a +firstWhere _ [] = Nothing +firstWhere f (x:xs) = if f x then Just x else firstWhere f xs + +addDir :: Direction -> (Int, Int) -> (Int, Int) +addDir dir (x, y) = case dir of + DirUp -> (x-1, y) + DirDown -> (x+1, y) + DirLeft -> (x, y-1) + DirRight -> (x, y+1) + +doMove :: (Array (Int, Int) Square) -> Direction -> (Array (Int, Int) Square) +doMove arr dir = case arr!square of + Empty -> arr // [(square, Box), ((addDir dir rpos), Robot), (rpos, Empty)] + Block -> arr + where square = fromJust $ firstWhere (\x -> arr!x==Empty || arr!x==Block) $ getPushRow arr dir + rpos = (\(a, _) -> a) $ head $ filter (\(_, b) -> b==Robot) $ assocs arr + +solve1 :: ((Array (Int, Int) Square), [Direction]) -> Int +solve1 = sum . map (\(x, y) -> 100*x + y) . map (\(a, _) -> a) . filter (\(_, b) -> b==Box) . assocs . uncurry (foldl doMove) + +printGrid :: (Array (Int, Int) Square) -> String +printGrid arr = concat $ [concat [show (arr!(x, y)) | y <- [0..99]] ++ "\n" | x <- [0..49]] + +consequentPushes :: (Array (Int, Int) Square) -> Direction -> [(Int, Int)] -> Maybe [(Int, Int)] +consequentPushes arr dir = (\x -> if elem Block (map (arr!) x) then Nothing else Just x) . nub . concat . map (\(a, b) -> case arr!(a, b) of + BoxL -> [(a, b), (a, b+1)] + BoxR -> [(a, b), (a, b-1)] + _ -> [(a, b)] + ) . map (addDir dir) + +needToPush :: (Array (Int, Int) Square) -> Direction -> [(Int, Int)] -> Maybe [(Int, Int)] +needToPush arr dir pushes = case nextPushes of + Nothing -> Nothing + Just xs -> if (filteredPushes == [] || filteredPushes == pushes) then Just pushes else case tail of + Nothing -> Nothing + Just tail' -> Just (pushes ++ filteredPushes ++ tail') + where filteredPushes = filter (\x -> arr!x /= Empty) $ fromJust nextPushes + nextPushes = consequentPushes arr dir pushes + tail = needToPush arr dir filteredPushes + +doMove2 :: (Array (Int, Int) Square) -> Direction -> (Array (Int, Int) Square) +doMove2 arr dir = case needToPush arr dir [rpos] of + Nothing -> arr + Just pospos -> arr // [(pos, Empty) | pos <- pospos] // [((addDir dir pos), arr!pos) | pos <- pospos] // [(rpos, Empty)] + where rpos = (\(a, _) -> a) $ head $ filter (\(_, b) -> b==Robot) $ assocs arr + +solve2 :: ((Array (Int, Int) Square), [Direction]) -> Int +solve2 = sum . map (\(x, y) -> 100*x + y) . map (\(a, _) -> a) . filter (\(_, b) -> b==BoxL) . assocs . uncurry (foldl (\x y -> doMove2 x y)) + +main :: IO() +main = do + fileinp1 <- readFile "input.txt" + fileinp2 <- readFile "input2.txt" + let parsed1 = splitInput $ S.splitOn "\n\n" fileinp1 + let parsed2 = splitInput $ S.splitOn "\n\n" fileinp2 + let solved1 = solve1 parsed1 + let solved2 = solve2 parsed2 + print solved1 + print solved2