diff --git a/11/input.txt b/11/input.txt new file mode 100644 index 0000000..cfbdc33 --- /dev/null +++ b/11/input.txt @@ -0,0 +1,10 @@ +5421451741 +3877321568 +7583273864 +3451717778 +2651615156 +6377167526 +5182852831 +4766856676 +3437187583 +3633371586 diff --git a/11/octoflash.hs b/11/octoflash.hs new file mode 100644 index 0000000..eb16571 --- /dev/null +++ b/11/octoflash.hs @@ -0,0 +1,93 @@ +import Data.Char (digitToInt) + +main :: IO () +main = do + input <- getContents + let + octopodes = (map (map digitToInt) . lines) input + (putStrLn . show . solution1) octopodes + (putStrLn . show . solution2) octopodes + +solution1 :: [[Int]] -> Int +solution1 m = snd (iterate flashSimulate (m, 0) !! 100) + +solution2 :: [[Int]] -> Int +solution2 m = countUntil (all (all (==0)) . fst) flashSimulate (m, 0) + +flashSimulate :: ([[Int]], Int) -> ([[Int]], Int) +flashSimulate (octopodes, flashes) = + (refreshOctopodes exhaustedOctopodes, flashes + countExhaustedOctopodes exhaustedOctopodes) + where + exhaustedOctopodes = flashStep octopodes + countExhaustedOctopodes = foldr (\l a -> length l + a) 0 . map (filter (> 9)) + refreshOctopodes = map (map (\o -> if o > 9 then 0 else o)) + +flashStep :: [[Int]] -> [[Int]] +flashStep = propagateFlashes . map (map (+1)) + where + propagateFlashes :: [[Int]] -> [[Int]] + propagateFlashes = until allExhausted flashOctopi + where + allExhausted :: [[Int]] -> Bool + allExhausted = all (all (/= 10)) + flashOctopi :: [[Int]] -> [[Int]] + flashOctopi m = map (map (incrementFlashing m)) + [[(x, y) | y <- [0..length (m !! x) - 1]] | x <- [0..length m - 1]] + where + incrementFlashing ::[[Int]] -> (Int, Int) -> Int + incrementFlashing m' o + | charge < 10 && newCharge > 10 = 10 -- Ensure we don't miss an increment + | otherwise = charge + numFlashingNeighbors o + where + newCharge = charge + numFlashingNeighbors o + charge = m' !!! o + numFlashingNeighbors :: (Int, Int) -> Int + numFlashingNeighbors = length . filter (\o -> (m !!! o) == 10) . (flip adjacent m) + +(!!!) :: [[Int]] -> (Int, Int) -> Int +(!!!) m index = m !! (fst index) !! (snd index) + +countUntil :: (a -> Bool) -> (a -> a) -> a -> Int +countUntil p f = call + where + call x + | p x = 0 + | otherwise = call (f x) + 1 + +adjacent :: (Int, Int) -> [[Int]] -> [(Int, Int)] +adjacent (x, y) m = [(x+i, y+j) | + i <- [-1..1], + j <- [-1..1], + -- (i, j) /= (0, 0), + x+i >= 0, + y+j >= 0, + x+i < length m, + y+j < length (m !! 0)] + +-- Tests + +testInput1 = [ + "5483143223", + "2745854711", + "5264556173", + "6141336146", + "6357385478", + "4167524645", + "2176841721", + "6882881134", + "4846848554", + "5283751526" + ] +parsedTestInput1 = map (map digitToInt) testInput1 + +testInput2 = [ + "11111", + "19991", + "19191", + "19991", + "11111" + ] +parsedTestInput2 = map (map digitToInt) testInput2 + +test1 = solution1 parsedTestInput1 +test2 = solution2 parsedTestInput1 diff --git a/12/Parsing.hs b/12/Parsing.hs new file mode 100644 index 0000000..8ad0f3f --- /dev/null +++ b/12/Parsing.hs @@ -0,0 +1,23 @@ +module Parsing ( + splitByString + ) where + +import Data.List (isPrefixOf) + +splitByString :: String -> String -> [String] +splitByString _ "" = [] +splitByString splitter string = + let (chunk, rest) = spanNextSplit string + in + chunk:(splitByString splitter rest) + where + spanNextSplit :: String -> (String, String) + spanNextSplit [] = ([], []) + spanNextSplit everything@(char:rest) + | splitter `isPrefixOf` rest = + ([char], (drop ((length splitter) + 1) everything)) + | otherwise = + let + (start, end) = spanNextSplit rest + in + (char:start, end) diff --git a/12/cavesearcher.hs b/12/cavesearcher.hs new file mode 100644 index 0000000..ed63250 --- /dev/null +++ b/12/cavesearcher.hs @@ -0,0 +1,123 @@ +import Data.Char (isLower) +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import Debug.Trace (traceShow, traceShowId) +import Parsing (splitByString) + +main :: IO () +main = do + input <- getContents + let + caves = parseCaves input + (putStrLn . show . solution1) caves + (putStrLn . show . solution2) caves + +solution1 :: Map.Map String [String] -> Int +solution1 = length . cavePaths + +solution2 :: Map.Map String [String] -> Int +solution2 = length . cavePaths2 + +parseCaves :: String -> Map.Map String [String] +parseCaves = Map.fromListWith (++) . flatmap addReverse . map tupleFromList . map (splitByString "-") . lines + where + addReverse :: (String, [String]) -> [(String, [String])] + addReverse t@(a, b) = [t, (head b, [a])] + tupleFromList :: [String] -> (String, [String]) + tupleFromList [] = undefined + tupleFromList (x:xs) + -- Since the second part is always expected to be a cave label + -- or "end", this should never be > 1 + | length xs > 1 = undefined + | otherwise = (x, xs) + +cavePaths :: Map.Map String [String] -> [[String]] +cavePaths caveMap = followSingle caveMap Set.empty "start" + +cavePaths2 :: Map.Map String [String] -> [[String]] +cavePaths2 caveMap = followOneRepeat caveMap Set.empty "start" + +followSingle :: Map.Map String [String] -> Set.Set String -> String -> [[String]] +followSingle caveMap visited node + | node == "end" = [[node]] + | otherwise = + let + v' = Set.insert node visited + in + map ((:) node) (flatmap (followSingle caveMap v') adjacent) + where + adjacent :: [String] + adjacent = filter (not . visitedSmall) (Map.findWithDefault [] node caveMap) + visitedSmall :: String -> Bool + visitedSmall n = all isLower n && n `elem` visited + +followOneRepeat :: Map.Map String [String] -> Set.Set String -> String -> [[String]] +followOneRepeat caveMap visited node + | node == "end" = [[node]] + | all isLower node && node `elem` visited = + followSingle caveMap visited node + | otherwise = + let + v' = Set.insert node visited + in + map ((:) node) (flatmap (followOneRepeat caveMap v') adjacent) + where + adjacent :: [String] + adjacent = filter (/= "start") (Map.findWithDefault [] node caveMap) + +flatmap :: (t -> [a]) -> [t] -> [a] +flatmap _ [] = [] +flatmap f (x:xs) = f x ++ flatmap f xs + +-- Tests + +testInput1 = unlines [ + "start-A", + "start-b", + "A-c", + "A-b", + "b-d", + "A-end", + "b-end" + ] + +testInput2 = unlines [ + "dc-end", + "HN-start", + "start-kj", + "dc-start", + "dc-HN", + "LN-dc", + "HN-end", + "kj-sa", + "kj-HN", + "kj-dc"] + +testInput3 = unlines [ + "fs-end", + "he-DX", + "fs-he", + "start-DX", + "pj-DX", + "end-zg", + "zg-sl", + "zg-pj", + "pj-he", + "RW-he", + "fs-DX", + "pj-RW", + "zg-RW", + "start-pj", + "he-WI", + "zg-he", + "pj-fs", + "start-RW"] + +parsedTestInput1 = parseCaves testInput1 +test1 = cavePaths parsedTestInput1 +test2 = cavePaths2 parsedTestInput1 +test3 = cavePaths2 (parseCaves testInput2) +test4 = cavePaths2 (parseCaves testInput3) + +printPaths :: [[String]] -> IO () +printPaths = putStr . unlines . (map (foldr1 (\c a -> c++"->"++a))) diff --git a/12/input.txt b/12/input.txt new file mode 100644 index 0000000..4067b56 --- /dev/null +++ b/12/input.txt @@ -0,0 +1,24 @@ +yb-pi +jg-ej +yb-KN +LD-start +end-UF +UF-yb +yb-xd +qx-yb +xd-end +jg-KN +start-qx +start-ej +qx-LD +jg-LD +xd-LD +ej-qx +end-KN +DM-xd +jg-yb +ej-LD +qx-UF +UF-jg +qx-jg +xd-UF