data/Y2024/D05/example

@@ -1,28 +0,0 @@
-47|53
-97|13
-97|61
-97|47
-75|29
-61|13
-75|53
-29|13
-97|29
-53|29
-61|53
-97|53
-61|29
-47|13
-75|47
-97|75
-47|61
-75|61
-47|29
-75|13
-53|13
-
-75,47,61,53,29
-97,61,53,29,13
-75,29,13
-75,97,47,61,53
-61,13,29
-97,13,75,29,47

data/Y2024/D06/example

@@ -1,10 +0,0 @@
-....#.....
-.........#
-..........
-..#.......
-.......#..
-..........
-.#..^.....
-........#.
-#.........
-......#...

src/AoC/Util.hs

@@ -1,8 +1,5 @@
 -- | Internal module in order to facilitate testability.
-module AoC.Util (solveRiddle, readFileUtf8, module A, mkMatrix, Matrix) where
+module AoC.Util (solveRiddle, readFileUtf8) where
-
-import Data.Array (Array)
-import Data.Array qualified as A
 
 readFileUtf8 :: (MonadIO m) => FilePath -> m Text
 readFileUtf8 = fmap (decodeUtf8With lenientDecode) . readFileBS
@@ -12,19 +9,3 @@ solveRiddle file solver = do
   results <- solver <$> readFileUtf8 file
   forM_ (results `zip` [1 :: Int ..]) $ \(solution, part) ->
     putTextLn $ "  solution to part-" <> show part <> ": " <> solution
-
-type Matrix a = Array (Int, Int) a
-
-mkMatrix :: [[a]] -> Matrix a
-mkMatrix vss =
-  A.array
-    ((1, 1), (w, h))
-    [ ((x, y), v)
-    | (y, vs) <- zip [1 ..] vss
-    , (x, v) <- zip [1 ..] vs
-    ]
- where
-  w = case vss of
-    [] -> 0
-    (vs : _) -> length vs
-  h = length vss

src/AoC/Y2024/D05.hs

@@ -1,88 +1,6 @@
-{- HLINT ignore "Use bimapF" -}
-{-# LANGUAGE RecordWildCards #-}
-
 module AoC.Y2024.D05 (solve) where
 
 import AoC.Riddle
 
--- import Data.Set qualified as S
-
-import Data.Set qualified as S
-import Data.String (lines)
-import Data.Text (splitOn)
-import Prelude hiding (lines)
-
-data Puzzle = Puzzle
-  { orderingRules :: Rules
-  , updates :: [Update]
-  }
-  deriving stock (Show)
-
-type Rules = Set (Page, Page)
-type Page = Int
-type Update = [Page]
-
-parse :: Riddle -> Maybe Puzzle
-parse riddle = do
-  let
-    (p1, p2) = break null $ lines $ toString riddle
-  p2' <- nonEmpty p2
-  Puzzle <$> parseOrderings p1 <*> parseRules (tail p2')
-
-parseOrderings :: [String] -> Maybe Rules
-parseOrderings s = do
-  p <- traverse (\l -> (,) <$> readMaybe (take 2 l) <*> readMaybe (drop 3 l)) s
-  pure $ fromList p
-
-parseRules :: [String] -> Maybe [Update]
-parseRules = mapM parseRule
-
-parseRule :: String -> Maybe Update
-parseRule = mapM readMaybe . fmap toString . splitOn "," . toText
-
-isSafe :: Rules -> Update -> Bool
-isSafe _ [] = True
-isSafe rules (u : us) = correctlyPositioned rules u us && isSafe rules us
-
-correctlyPositioned :: Rules -> Page -> Update -> Bool
-correctlyPositioned rules page = all (correctlyPositionedAgainst rules page)
-
-correctlyPositionedAgainst :: Rules -> Page -> Page -> Bool
-correctlyPositionedAgainst rules a b = S.member (a, b) rules && S.notMember (b, a) rules
-
-middlePage :: [a] -> Maybe a
-middlePage update = case length update `mod` 2 of
-  0 -> Nothing
-  _ ->
-    let
-      half = length update `div` 2
-      m = drop half $ take (half + 1) update
-     in
-      case m of
-        [p] -> Just p
-        _ -> Nothing
-
-sortCorrectly :: Puzzle -> Puzzle
-sortCorrectly Puzzle{..} = Puzzle{orderingRules, updates = fixedUpdates}
- where
-  fixedUpdates :: [Update]
-  fixedUpdates = sortBy f <$> filter (not . isSafe orderingRules) updates
-
-  f :: Page -> Page -> Ordering
-  f a b = case (S.member (a, b) orderingRules, S.member (b, a) orderingRules) of
-    (True, _) -> LT
-    (_, True) -> GT
-    _ -> EQ
-
-part1 :: Riddle -> Maybe Int
-part1 riddle = do
-  Puzzle{..} <- parse riddle
-  sum <$> mapM middlePage (filter (isSafe orderingRules) updates)
-
-part2 :: Riddle -> Maybe Int
-part2 riddle = do
-  Puzzle{..} <- sortCorrectly <$> parse riddle
-  sum <$> mapM middlePage (filter (isSafe orderingRules) updates)
-
 solve :: (MonadIO m) => Text -> m (Either Text Solution)
-solve riddle = pure $ Right [fromIntegral $ fromMaybe 0 (part1 riddle), fromIntegral $ fromMaybe 0 (part2 riddle)]
+solve _ = pure $ Left "not yet implemented"

src/AoC/Y2024/D06.hs

@@ -1,101 +1,6 @@
-{-# LANGUAGE LambdaCase #-}
-{- HLINT ignore "Use bimapF" -}
-{-# LANGUAGE RecordWildCards #-}
-
 module AoC.Y2024.D06 (solve) where
 
 import AoC.Riddle
-import AoC.Util
-
-import Data.Array qualified as A
-
--- import Data.Set qualified as S
-
-import Data.String (lines)
-import Prelude hiding (lines)
-
-data Direction
-  = U
-  | R
-  | D
-  | L
-  deriving stock (Show, Eq, Enum)
-
-data Tile
-  = Free
-  | Obstruction
-  | Visited
-  | Guard Direction
-  deriving stock (Show, Eq)
-
-type Position = (Int, Int)
-
-directionToVector :: Direction -> Position
-directionToVector = \case
-  U -> (0, -1)
-  R -> (1, 0)
-  D -> (0, 1)
-  L -> (-1, 0)
-
-parseTile :: Char -> Maybe Tile
-parseTile = \case
-  '.' -> pure Free
-  '#' -> pure Obstruction
-  '^' -> pure $ Guard U
-  '>' -> pure $ Guard R
-  'v' -> pure $ Guard D
-  '<' -> pure $ Guard L
-  _ -> Nothing
-
-data MapState where
-  MapState ::
-    { labMap :: Matrix Tile
-    , guardPosition :: Maybe (Position, Direction)
-    } ->
-    MapState
-  deriving stock (Show)
-
-parseMap :: Riddle -> Maybe (Matrix Tile)
-parseMap riddle = do
-  let
-    vss :: [[Char]]
-    vss = lines . toString $ riddle
-
-    vss' :: [Maybe [Tile]]
-    vss' = mapM parseTile <$> vss
-
-  mkMatrix <$> sequence vss'
-
-locateGuard :: Matrix Tile -> Maybe (Position, Direction)
-locateGuard = lookupGuard . fmap swap . A.assocs
- where
-  lookupGuard :: [(Tile, Position)] -> Maybe (Position, Direction)
-  lookupGuard = getFirst . foldMap checkGuard
-
-  checkGuard :: (Tile, Position) -> First (Position, Direction)
-  checkGuard (Guard d, pos) = pure (pos, d)
-  checkGuard _ = mempty
-
-parse :: Riddle -> Maybe MapState
-parse riddle = do
-  labMap <- parseMap riddle
-  pure $ MapState{labMap, guardPosition = locateGuard labMap}
-
-movePosition :: Position -> Direction -> Position
-movePosition (x, y) d =
-  let (dx, dy) = directionToVector d
-   in (x + dx, y + dy)
-
-moveGuard :: MapState -> Maybe (Position, MapState)
-moveGuard MapState{..} = do
-  (pos, d) <- guardPosition
-  case d of {}
-
-part1 :: Riddle -> Maybe Int
-part1 riddle = Nothing
-
-part2 :: Riddle -> Maybe Int
-part2 riddle = Nothing
 
 solve :: (MonadIO m) => Text -> m (Either Text Solution)
-solve riddle = pure $ Right [fromIntegral $ fromMaybe 0 (part1 riddle), fromIntegral $ fromMaybe 0 (part2 riddle)]
+solve _ = pure $ Left "not yet implemented"

test/spec/AoCSpec/Y2024Spec.hs

@@ -21,6 +21,8 @@ spec = do
     it "calculates correctly" do
       runAoC Y2024 D04 `shouldReturn` Right [2567, 2029]
 
+{-
   describe "Day 5" do
-    it "calculates correctly" do
+    it "calculates the example correctly" do
-      runAoC Y2024 D05 `shouldReturn` Right [5452, 4598]
+      runAoCExample Y2023 D05 `shouldReturn` Right [35]
+-}