day 11 and 12

2021/.vscode/settings.json

@@ -0,0 +1,5 @@
+{
+    "cSpell.words": [
+        "octos"
+    ]
+}

2021/day11.hs

@@ -0,0 +1,44 @@
+module Day11 where
+import Data.Array
+    ( Ix, Array, (!), (//), assocs, bounds, listArray )
+import Data.Char (digitToInt)
+import Data.Maybe ( catMaybes, mapMaybe )
+import Data.List (unfoldr)
+-- import GHC.Ix (Ix)
+
+data Point = P Int Int deriving (Eq, Ord, Ix, Show)
+
+flashOctos:: [Point] -> Array Point Int -> [Point] -> (Array Point Int, [Point])
+flashOctos [] octos points = (octos, points)
+flashOctos (p@(P x y):xs) octos points = if p `elem` points || octos ! p <= 9
+    then flashOctos xs octos points
+    else flashOctos (xs ++ filter (\p -> octos ! p >= 9) neighs) (octos // increments) (p:points)
+    where
+        neighs = catMaybes $ (\x' y' -> if (x == x' && y == y') || x' < 1 || x' > mx || y' < 1 || y' > my then Nothing else Just (P x' y')) <$> [x-1..x+1] <*> [y-1..y+1]
+        (P 1 1, P mx my) = bounds octos
+        increments = map(\p -> (p, (octos ! p) + 1)) neighs
+
+stepOctos :: Array Point Int -> (Array Point Int, Int)
+stepOctos octos = (field // map (\p -> (p,0)) toReset, length toReset)
+    where
+        (field,toReset) = flashOctos points octos' []
+        points = mapMaybe (\(p,x) -> if x > 9 then Just p else Nothing) $ assocs octos'
+        octos' = fmap (+ 1) octos
+
+part2 :: Array Point Int -> Int -> Int
+part2 a i = if c == length a' then i else part2 a' (i+1)
+    where (a', c) = stepOctos a
+
+main :: IO ()
+main = do
+    input <- map (map digitToInt) . lines <$> getContents
+
+    putStr "part 1: "
+    let octos = listArray (P 1 1, P (length input) (length (head input))) (concat input)
+    let (_,count) = foldr (\_ (o, count) -> let (o', c') = stepOctos o in (o', count+c')) (octos, 0) [1..100]
+    print count
+
+    putStr "part 2: " >> print (part2 octos 1)
+
+
+    return ()

2021/day11.input

@@ -0,0 +1,10 @@
+1443582148
+6553734851
+1451741246
+8835218864
+1662317262
+1731656623
+1128178367
+5842351665
+6677326843
+7381433267

2021/day12.hs

@@ -0,0 +1,49 @@
+module Day12 where
+import qualified Data.HashSet
+import Data.Map ( Map, fromList, unionWith, empty, toList, (!) )
+import Data.List.Split (splitOn)
+import qualified Data.Char
+import Data.Maybe (mapMaybe)
+
+type Path = (String,String)
+type System = Map String [String]
+
+readPath :: String -> Path
+readPath s = (from,to) where [from,to] = splitOn "-" s
+
+addPath :: Path -> System -> System
+addPath (from,to) = unionWith (++) (Data.Map.fromList [(from,[to]), (to,[from])])
+
+isLower :: String -> Bool
+isLower = Data.Char.isLower . head
+isUpper :: String -> Bool
+isUpper = Data.Char.isUpper . head
+
+pathFinder :: System -> [String] -> [[String]]
+pathFinder sys p@("end":xs) = [p]
+pathFinder sys p@(x:xs) = concatMap (\next -> pathFinder sys (next:p)) elig
+    where elig = filter (\cave -> isUpper cave || cave `notElem` p) (sys ! x)
+
+pathFinder2 :: System -> [String] -> Bool -> [[String]]
+pathFinder2 sys p@("end":xs) _ = [p]
+pathFinder2 sys p@(x:xs) True = concatMap (\next -> pathFinder2 sys (next:p) True) elig
+    where elig = filter (\cave -> isUpper cave || cave `notElem` p) (sys ! x)
+pathFinder2 sys p@(x:xs) False = concatMap (\next -> pathFinder2 sys (next:p) (dup next)) elig
+    where
+        elig = filter (/= "start") (sys ! x)
+        dup cave = isLower cave && cave `elem` p
+
+
+
+main :: IO ()
+main = do
+    input <- map readPath . lines <$> getContents
+    let system = foldr addPath Data.Map.empty input
+
+    putStrLn "part 1: "
+    let paths = map reverse $ pathFinder system ["start"]
+    print $ length paths
+
+    putStrLn "part 2: "
+    let paths = map reverse $ pathFinder2 system ["start"] False 
+    print $ length paths

2021/day12.input

@@ -0,0 +1,21 @@
+ma-start
+YZ-rv
+MP-rv
+vc-MP
+QD-kj
+rv-kj
+ma-rv
+YZ-zd
+UB-rv
+MP-xe
+start-MP
+zd-end
+ma-UB
+ma-MP
+UB-xe
+end-UB
+ju-MP
+ma-xe
+zd-UB
+start-xe
+YZ-end