From 07e683475fa1ef5f6dc17e62050e95a55bb2700f Mon Sep 17 00:00:00 2001
From: Jordan Doyle <jordan@doyle.la>
Date: Sat, 30 Dec 2023 01:09:26 +0000
Subject: [PATCH] Add day 23

---
 2023/23.hs | 78 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)
 create mode 100755 2023/23.hs

diff --git a/2023/23.hs b/2023/23.hs
new file mode 100755
index 0000000..af636b7
--- /dev/null
+++ b/2023/23.hs
@@ -0,0 +1,78 @@
+#!/usr/bin/env nix-shell
+#!nix-shell --pure -i "runghc -- -i../" -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ parallel ])"
+
+import Aoc (readAndParseStdin)
+import Control.Parallel (par, pseq)
+import Data.Array
+import Data.IntSet (IntSet)
+import qualified Data.IntSet as IntSet
+import Text.Parsec (char, choice, endBy, many1)
+import Text.Parsec.String (Parser)
+
+main = do
+  input <- readAndParseStdin parseGrid
+  print $ part1 input
+  print $ part2 input
+
+part1 :: [[Path]] -> Int
+part1 = walkMazeH True
+
+part2 :: [[Path]] -> Int
+part2 = walkMazeH False
+
+walkMazeH :: Bool -> [[Path]] -> Int
+walkMazeH slippery input = maximum $ map (subtract 1 . IntSet.size) $ fromDList $ walkMaze (1, 0) (IntSet.singleton $ hashCoord (1, 0))
+  where
+    maxX = length (head input)
+    maxY = length input
+    exit = (maxX - 2, maxY - 1)
+    grid = array ((0, 0), (maxX, maxY)) [((x, y), input !! y !! x) | y <- [0 .. maxY - 1], x <- [0 .. maxX - 1]]
+    hashCoord (x, y) = x * 1000 + y
+    walkMaze :: (Int, Int) -> IntSet -> DList IntSet
+    walkMaze pos@(x, y) cacc
+      | pos == exit = toDList [newCacc]
+      | slippery = case grid ! (x, y) of
+          Path -> parallelTraverseAll
+          Forest -> error "invalid state"
+          UpSlope -> parallelTraverse (x, y - 1)
+          RightSlope -> parallelTraverse (x + 1, y)
+          DownSlope -> parallelTraverse (x, y + 1)
+          LeftSlope -> parallelTraverse (x - 1, y)
+      | otherwise = parallelTraverseAll
+      where
+        newCacc = IntSet.insert (hashCoord pos) cacc
+        isValidPath pos@(x, y) = y >= 0 && x >= 0 && y < maxY && x < maxX && IntSet.notMember (hashCoord pos) cacc && (grid ! pos) /= Forest
+        parallelTraverseAll = foldr parallelWalk (toDList []) $ filter isValidPath [(x, y - 1), (x + 1, y), (x, y + 1), (x - 1, y)]
+        parallelWalk path acc = go path `par` (acc `pseq` (acc `dappend` go path))
+        parallelTraverse pos = if isValidPath pos then go pos else toDList []
+        go pos = walkMaze pos newCacc
+
+type DList a = [a] -> [a]
+
+{-# INLINEABLE toDList #-}
+toDList :: [a] -> DList a
+toDList xs = (xs ++)
+
+{-# INLINEABLE fromDList #-}
+fromDList :: DList a -> [a]
+fromDList dl = dl []
+
+{-# INLINEABLE dappend #-}
+dappend :: DList a -> DList a -> DList a
+dappend dl1 dl2 = dl1 . dl2
+
+parseGrid :: Parser [[Path]]
+parseGrid = parseGridRow `endBy` char '\n'
+  where
+    parseGridRow = many1 parseGridTile
+    parseGridTile =
+      choice
+        [ Path <$ char '.',
+          Forest <$ char '#',
+          UpSlope <$ char '^',
+          RightSlope <$ char '>',
+          DownSlope <$ char 'v',
+          LeftSlope <$ char '<'
+        ]
+
+data Path = Path | Forest | UpSlope | RightSlope | DownSlope | LeftSlope deriving (Enum, Show, Eq)
--
libgit2 1.7.2