From 0dec9f0cb17b388b5871761b64bf9d9a8f61f478 Mon Sep 17 00:00:00 2001
From: Neil Smith <NeilNjae@users.noreply.github.com>
Date: Mon, 1 Jan 2024 11:49:15 +0000
Subject: [PATCH] Done day 23 part 1

---
 advent-of-code23.cabal |  6 +++
 advent23/Main.hs       | 89 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 95 insertions(+)
 create mode 100644 advent23/Main.hs

diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal
index 3f78f06..ec2ef49 100644
--- a/advent-of-code23.cabal
+++ b/advent-of-code23.cabal
@@ -226,3 +226,9 @@ executable advent22
   import: common-extensions, build-directives
   main-is: advent22/Main.hs
   build-depends: linear, text, attoparsec, lens, containers
+
+executable advent23
+  import: common-extensions, build-directives
+  main-is: advent23/Main.hs
+  build-depends: linear, containers
+  
\ No newline at end of file
diff --git a/advent23/Main.hs b/advent23/Main.hs
new file mode 100644
index 0000000..b811082
--- /dev/null
+++ b/advent23/Main.hs
@@ -0,0 +1,89 @@
+-- Writeup at https://work.njae.me.uk/2023/12/29/advent-of-code-2023-day-21/
+
+import AoC
+import Linear (V2(..), (^+^))
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+data Slide = SlideLeft | SlideRight | SlideUp | SlideDown
+  deriving (Show, Eq)
+
+type Position = V2 Int -- r, c
+type Grid = S.Set Position
+type Slides = M.Map Position Slide
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let (forest, slides, start, end) = mkGrid text
+      -- print forest
+      -- print slides
+      -- print start
+      -- print end
+      -- print $ searchStep slides forest [start ^+^ (V2 1 0), start]
+      -- let paths = search slides forest end [] [[start ^+^ (V2 1 0), start]]
+      -- print $ fmap length paths
+      print $ part1 slides forest start end
+
+part1 slides forest start end = (maximum $ fmap length paths) - 1
+  where paths = search slides forest end [] [[start ^+^ (V2 1 0), start]]
+
+adjacents :: Position -> Slides -> Grid -> [Position]
+adjacents here slides walls = filter (`S.notMember` walls) $ fmap (^+^ here) deltas
+  where deltas = case M.lookup here slides of
+                  Nothing ->  [ V2 0 1, V2 1 0, V2 0 (-1), V2 (-1) 0 ]
+                  Just SlideLeft -> [ V2 0 (-1) ]
+                  Just SlideRight -> [ V2 0 1 ]
+                  Just SlideUp -> [ V2 (-1) 0 ]
+                  Just SlideDown -> [ V2 1 0 ]
+  
+searchStep :: Slides -> Grid -> [Position] -> [[Position]]
+searchStep _ _ [] = []
+searchStep slides forest path@(here:rest) = fmap (:path) valids
+  where nexts = adjacents here slides forest
+        valids = filter (`notElem` rest) nexts
+
+
+search :: Slides -> Grid -> Position -> [[Position]] -> [[Position]] -> [[Position]]
+search _ _ _ foundPaths [] = foundPaths
+search slides forest goal foundPaths (current:agenda)
+  | head current == goal = search slides forest goal (current:foundPaths) agenda
+  | otherwise = search slides forest goal foundPaths (agenda ++ extendeds) 
+  where extendeds = searchStep slides forest current
+
+
+-- showGrid :: Grid -> (Position, Position) -> Grid -> String
+-- showGrid rocks bounds cells = unlines $ intercalate [" "] $ chunksOf 7 $ fmap (showRow rocks bounds cells) [-28..34]
+--   where showRow rocks bounds cells r = intercalate " " $ chunksOf 7 $ fmap ((showCell rocks bounds cells) . V2 r) [-28..34]
+--         showCell rocks bounds cells here
+--           | not $ notAtRock rocks bounds here = '#'
+--           | here `S.member` cells = 'O'
+--           | otherwise = '.'
+
+-- reading the map
+
+mkGrid :: String -> (Grid, Slides, Position, Position)
+mkGrid text = (forest, slides, start, end)
+  where rows = lines text
+        maxR = length rows - 1
+        maxC = (length $ head rows) - 1
+        forest = S.fromList [ V2 r c | r <- [0..maxR], c <- [0..maxC]
+                            , rows !! r !! c == '#'
+                            ]
+        slides = M.fromList [ (V2 r c, readSlide (rows !! r !! c)) 
+                            | r <- [0..maxR], c <- [0..maxC]
+                            , elem (rows !! r !! c) ("<>^v" :: String)
+                            ]
+        start = head $ [ V2 0 c | c <- [0..maxC]
+                       , rows !! 0 !! c == '.'
+                       ]
+        end = head $ [ V2 maxR c | c <- [0..maxC]
+                     , rows !! maxR !! c == '.'
+                     ]
+
+readSlide :: Char -> Slide
+readSlide '<' = SlideLeft
+readSlide '>' = SlideRight
+readSlide '^' = SlideUp
+readSlide 'v' = SlideDown
-- 
2.34.1