2015 Day 18 in Haskell

2015/day18/day18.hs

@@ -0,0 +1,38 @@
+import Aoc
+
+parseLine :: String -> [Bool]
+parseLine = map toBool
+    where
+        toBool '.' = False
+        toBool '#' = True
+
+countNeighbours :: [[Bool]] -> (Bool, Int)
+countNeighbours [[a, b, c], [d, e, f], [g, h, i]] = (e, length (filter id [a, b, c, d, f, g, h, i]))
+
+survives :: (Bool, Int) -> Bool
+survives (False, n) = n == 3
+survives (True, n) = n == 2 || n == 3
+
+simulate :: [[Bool]] -> [[Bool]]
+simulate = kernelMap (survives . countNeighbours) (Just False)
+
+numOn :: [[Bool]] -> Int
+numOn = sum . map (sum . map fromEnum)
+
+doSimulate :: ([[Bool]] -> [[Bool]]) -> [[Bool]] -> Int
+doSimulate simulate board = numOn $ iterate simulate board !! 100
+
+part1 :: [[Bool]] -> Int
+part1 = doSimulate simulate
+
+part2 :: [[Bool]] -> Int
+part2 = doSimulate simulate' . keepOn
+    where
+        updateFirst f (x:xs) = f x: xs
+        updateLast f (x:xs) = if null xs then [f x] else x: updateLast f xs
+        updateEnds f = updateFirst f . updateLast f
+        keepOn = updateEnds (updateEnds $ const True)
+        simulate' = keepOn . simulate
+
+main :: IO ()
+main = aocMain (map parseLine) part1 part2

2024/day04/day04.hs

@@ -19,18 +19,6 @@ part1 board = horizontal board + vertical board + diagonal1 board + diagonal2 bo
         diagonal1 = vertical . sheer
         diagonal2 = diagonal1 . reverse
 
-kernelMapRow :: ([[a]] -> b) -> [a] -> [a] -> [a] -> [b]
-kernelMapRow kernel
-    (a:r0@(b:c:_))
-    (d:r1@(e:f:_))
-    (g:r2@(h:i:_)) =
-         kernel [[a,b,c],[d,e,f],[g,h,i]] : kernelMapRow kernel r0 r1 r2
-kernelMapRow _ [_, _] [_, _] [_, _] = []
-
-kernelMap :: ([[a]] -> b) -> [[a]] -> [[b]]
-kernelMap kernel (a:rest@(b:c:_)) = kernelMapRow kernel a b c : kernelMap kernel rest
-kernelMap _ [_, _] = []
-
 isXMAS :: [[Char]] -> Bool
 isXMAS [
     [a,  _,  b], 
@@ -43,7 +31,7 @@ isXMAS [
 isXMAS [[_, _, _], [_, _, _], [_, _, _]] = False
 
 part2 :: [String] -> Int
-part2 = sum . map (length . filter id) . kernelMap isXMAS
+part2 = sum . map (length . filter id) . kernelMap isXMAS Nothing
 
 main :: IO ()
 main = aocMain id part1 part2

aoc.hs

@@ -59,3 +59,25 @@ starsAndBars :: Int -> Int -> [[Int]]
 starsAndBars 0 b = [replicate (b+1) 0]
 starsAndBars n 0 = [[n]]
 starsAndBars n b = map (0:) (starsAndBars n (b-1)) ++ map (\xs -> head xs + 1 : tail xs) (starsAndBars (n-1) b)
+
+kernelMapRow' :: ([[a]] -> b) -> Maybe a -> [a] -> [a] -> [a] -> [b]
+kernelMapRow' kernel x
+    (a:r0@(b:c:_))
+    (d:r1@(e:f:_))
+    (g:r2@(h:i:_)) =
+         kernel [[a,b,c],[d,e,f],[g,h,i]] : kernelMapRow' kernel x r0 r1 r2
+kernelMapRow' kernel (Just x) [a, b] [c, d] [e, f] = [kernel [[a,b,x],[c,d,x],[e,f,x]]]
+kernelMapRow' _ Nothing [_, _] [_, _] [_, _] = []
+
+kernelMapRow :: ([[a]] -> b) -> Maybe a -> [a] -> [a] -> [a] -> [b]
+kernelMapRow kernel (Just x) a b c = kernelMapRow' kernel (Just x) (x:a) (x:b) (x:c)
+kernelMapRow kernel Nothing a b c = kernelMapRow' kernel Nothing a b c
+
+kernelMap' :: ([[a]] -> b) -> Maybe a -> [[a]] -> [[b]]
+kernelMap' kernel x (a:rest@(b:c:_)) = kernelMapRow kernel x a b c : kernelMap' kernel x rest
+kernelMap' kernel (Just x) [a, b] = [kernelMapRow kernel (Just x) a b (map (const x) b)]
+kernelMap' kernel Nothing [_, _] = []
+
+kernelMap :: ([[a]] -> b) -> Maybe a -> [[a]] -> [[b]]
+kernelMap kernel (Just x) as = kernelMap' kernel (Just x) ((map (const x) (head as)):as)
+kernelMap kernel Nothing as = kernelMap' kernel Nothing as