2016 13 and alt impl for 2021 d15

adventofcode.cabal

@@ -74,6 +74,7 @@ library
                      , Y2016.D09
                      , Y2016.D10
                      , Y2016.D12
+                     , Y2016.D13
                      , Y2018.D01
                      , Y2018.D02
                      , Y2018.D03
@@ -109,6 +110,7 @@ library
                      , cryptohash
                      , deepseq
                      , extra
+                     , ghc
                      , grid
                      , hashable
                      , heaps
@@ -122,6 +124,7 @@ library
                      , parsec
                      , repa
                      , safe
+                     , search-algorithms
                      , scientific
                      , text
                      , time
@@ -166,6 +169,7 @@ test-suite adventofcode-test
                      , Y2016.D09Spec
                      , Y2016.D10Spec
                      , Y2016.D12Spec
+                     , Y2016.D13Spec
                      , Y2018.D01Spec
                      , Y2018.D02Spec
                      , Y2018.D03Spec

app/Main.hs

@@ -28,10 +28,16 @@ usage = "Advent of Code solutions in Haskell"
 -}
 main :: IO ()
 main = do
-  Options (Flags { timed }) (Arguments year day part path args) <- getRecord usage
-  input <- TIO.readFile path 
+  Options (Flags { timed, input }) (Arguments year day part args) <- getRecord usage
+
+  problemText <- case input of
+    Nothing -> pure Nothing
+    Just p -> do
+      x <- TIO.readFile p
+      pure $ Just x
+
   let solution = solve year day part args
   if timed then do
-    (Measured { measTime }, _) <- measure (nf solution input) 1
+    (Measured { measTime }, _) <- measure (nf solution problemText) 1
     putStrLn $ "Elapsed: " ++ secs measTime
-  else putStrLn (solution input)
+  else putStrLn (solution problemText)

app/Options.hs

@@ -21,11 +21,11 @@ type Day  = Int
 type Part = Char
 type Path = String
 
-newtype Flags = Flags { timed :: Bool } deriving Generic
+data Flags = Flags { timed :: Bool, input :: Maybe Path } deriving Generic
 instance ParseRecord Flags where
 
 data Arguments =
-  Arguments Year Day Part Path [String] deriving Generic
+  Arguments Year Day Part [String] deriving Generic
 instance ParseRecord Arguments
 
 data Options = Options Flags Arguments

benchmark/Y2016/Bench.hs

@@ -66,4 +66,12 @@ benchmarks =
                 [ bench "large" $ nf (assembunnyRegisterInit (\x -> if x == 'c' then 1 else 0) 'a') input
                 ]
               ]
+        , bgroup "D13"
+          [ bgroup "partA"
+            [ bench "large" $ nf (officePath 1358) (31, 39)
+            ]
+          , bgroup "partB"
+            [ bench "large" $ nf (floodOffice 1358) 50
+            ]
+          ]
         ]

flake.nix

@@ -34,12 +34,14 @@
                 haskell-language-server = {};
               };
               # Non-Haskell shell tools go here
-              shell.buildInputs = with pkgs; [
+              shell.buildInputs = with pkgs; ([
                 cabal-install
                 cachix
-                haskellPackages.hspec-discover
                 lz4
-              ];
+              ] ++ (with haskellPackages; [
+                haskell-debug-adapter
+                hspec-discover
+              ]));
               modules = [
                 { packages.markup-parse.doHaddock = false; }
               ];

src/Y2016.hs

@@ -19,3 +19,4 @@ import Y2016.D02 as X
 import Y2016.D09 as X
 import Y2016.D10 as X
 import Y2016.D12 as X
+import Y2016.D13 as X

src/Y2016/D13.hs

@@ -0,0 +1,52 @@
+{-|
+Module:      Y2016.D13
+Description: Advent of Code Day 13 Solutions.
+License:     MIT
+Maintainer:  @tylerjl
+
+Solutions to the day 13 set of problems for <adventofcode.com>.
+-}
+module Y2016.D13 (floodOffice, officePath) where
+
+import Algorithm.Search (dijkstra)
+import Data.Bits (popCount)
+import Data.Set (Set)
+import qualified Data.Set as S
+import Y2015.Util ((<&&>))
+
+type Point = (Int, Int)
+data Tile = Space | Wall deriving Show
+
+officePath :: Int -> Point -> Maybe Int
+officePath seed target = fst
+  <$> dijkstra (neighbors seed) (const . const 1) (== target) (1, 1)
+
+floodOffice :: Int -> Int -> Set Point
+floodOffice seed maxSteps = go 0 S.empty (1, 1)
+  where
+    go :: Int -> Set Point -> Point -> Set Point
+    go steps seen node
+      | steps > maxSteps || node `S.member` seen = S.empty
+      | otherwise = S.unions
+                    $ S.singleton node
+                    : map (go (succ steps) (node `S.insert` seen)) (neighbors seed node)
+
+neighbors :: Int -> Point -> [Point]
+neighbors seed point = filter (inBounds <&&> (open . tileAt seed))
+  $ adjacentTo point
+  where
+    open Space = True
+    open Wall = False
+    inBounds (x, y) = x >= 0 && y >= 0
+
+adjacentTo :: Point -> [Point]
+adjacentTo (x, y) =
+  [             (x, y - 1)
+  , (x - 1, y),            (x + 1, y)
+  ,             (x, y + 1)
+  ]
+
+tileAt :: Int -> Point -> Tile
+tileAt seed (x, y) = if even (popCount q) then Space else Wall
+  where
+    q = seed + ((x * x) + (3 * x) + (2 * (x * y)) + y + (y * y))

src/Y2021/D15.hs

@@ -9,24 +9,31 @@ Solutions to the 2021 day 15 set of problems for <adventofcode.com>.
 -}
 module Y2021.D15
   ( parse15
+  , parse15'
   , part15A
   , part15B
+  , part15A'
+  , part15B'
   ) where
 
+import Algorithm.Search (dijkstra)
 import Control.Arrow
 import Data.Attoparsec.Text hiding  (take)
 import Data.Either.Utils            (fromRight)
 import Data.Foldable
 import Data.List.Extra              (transpose)
 import Data.Map.Strict              (Map)
 import Data.Text                    (Text)
+import Data.Vector                  (Vector)
 import Math.Geometry.Grid hiding    (distance)
 import Math.Geometry.Grid.Square
 import Math.Geometry.GridMap hiding (foldl', map, filter)
 import Math.Geometry.GridMap.Lazy
 
 import qualified Data.Heap as H
 import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import qualified Data.Vector as V
 import qualified Math.Geometry.GridMap as GM
 
 type Cavern = LGridMap RectSquareGrid Int
@@ -107,3 +114,42 @@ parse15 = fromRight . parseOnly (grid <$> parser)
       lazyGridMap (rectSquareGrid (length row) (length rows)) (concat $ transpose rows)
     parser = line `sepBy1` endOfLine <* atEnd
     line = many1 (read . (: []) <$> digit)
+
+-- Alternative implementation that's actually slower
+
+type Point = (Int, Int)
+type Tiles = Vector (Vector Int)
+
+part15A' :: Text -> Maybe Int
+part15A' (parse15' . T.strip -> tiles)
+  = fst <$> dijkstra neighbors' cost atGoal (0, 0)
+  where
+    neighbors' point = filter inBounds (neighbors point)
+    inBounds (x, y)
+      = x >= 0 && y >= 0 && y < V.length tiles && x < V.length row
+        where row = tiles V.! y
+    cost _ (x, y) = (tiles V.! y) V.! x
+    atGoal (x, y)
+      =  (y + 1) == V.length tiles
+      && (x + 1) == V.length row
+      where row = tiles V.! y
+
+part15B' :: Text -> Int
+part15B' _ = 0
+
+neighbors :: Point -> [Point]
+neighbors (x, y) =
+  [             (x, y - 1)
+  , (x - 1, y),            (x + 1, y)
+  ,             (x, y + 1)
+  ]
+
+parse15' :: Text -> Tiles
+parse15' (parseOnly cavernP -> Right tiles) = tiles
+parse15' (parseOnly cavernP -> Left _) = error "couldn't parse input"
+
+cavernP :: Parser Tiles
+cavernP = V.fromList <$> (xrow `sepBy` endOfLine)
+  where
+    xrow :: Parser (Vector Int)
+    xrow = V.fromList <$> many1 (read . (: []) <$> digit)

test/Y2016/D13Spec.hs

@@ -0,0 +1,12 @@
+module Y2016.D13Spec (spec) where
+
+import Y2016
+
+import Test.Hspec
+
+spec :: Spec
+spec = parallel $ do
+    describe "Day 13" $ do
+        describe "officePath" $ do
+            it "solves the example" $ do
+                officePath 10 (7, 4) `shouldBe` Just 11