From c27e24e063256fd39bd9a46dccf52eb1bb1e00e5 Mon Sep 17 00:00:00 2001 From: JasterV <49537445+JasterV@users.noreply.github.com> Date: Sun, 30 Mar 2025 20:59:08 +0200 Subject: [PATCH] refactor day6 part one --- aoc2024.cabal | 135 +++++++++++++++++++++++----------------------- package.yaml | 1 + src/Day6.hs | 62 ++++++++------------- src/Day6/Guard.hs | 30 +++++++++++ test/Day6Spec.hs | 26 +++++++++ 5 files changed, 148 insertions(+), 106 deletions(-) create mode 100644 src/Day6/Guard.hs create mode 100644 test/Day6Spec.hs diff --git a/aoc2024.cabal b/aoc2024.cabal index c0bd71b..9cda67c 100644 --- a/aoc2024.cabal +++ b/aoc2024.cabal @@ -1,77 +1,78 @@ -cabal-version: 2.2 -name: aoc2024 -version: 0.1.0.0 -license: BSD-3-Clause -license-file: LICENSE -copyright: 2025 Author name here -maintainer: example@example.com -author: Author name here -homepage: https://github.com/githubuser/aoc2024#readme -bug-reports: https://github.com/githubuser/aoc2024/issues -description: - Please see the README on GitHub at +cabal-version: 2.2 -build-type: Simple +-- This file has been generated from package.yaml by hpack version 0.37.0. +-- +-- see: https://github.com/sol/hpack + +name: aoc2024 +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/githubuser/aoc2024#readme +bug-reports: https://github.com/githubuser/aoc2024/issues +author: Author name here +maintainer: example@example.com +copyright: 2025 Author name here +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple extra-source-files: README.md CHANGELOG.md source-repository head - type: git - location: https://github.com/githubuser/aoc2024 + type: git + location: https://github.com/githubuser/aoc2024 library - exposed-modules: - Data.Matrix - Day1 - Day2 - Day3 - Day4 - Day5 - Day6 - - hs-source-dirs: src - other-modules: Paths_aoc2024 - autogen-modules: Paths_aoc2024 - default-language: Haskell2010 - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - - build-depends: - base >=4.7 && <5, - containers, - regex-tdfa >=1.3.2 && <1.4, - text >=2.0.2, - unordered-containers + exposed-modules: + Data.Matrix + Day1 + Day2 + Day3 + Day4 + Day5 + Day6 + Day6.Guard + other-modules: + Paths_aoc2024 + autogen-modules: + Paths_aoc2024 + hs-source-dirs: + src + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + base >=4.7 && <5 + , containers + , hashable + , regex-tdfa >=1.3.2 && <1.4 + , text >=2.0.2 + , unordered-containers + default-language: Haskell2010 test-suite aoc2024-test - type: exitcode-stdio-1.0 - main-is: Spec.hs - hs-source-dirs: test - other-modules: - Day1Spec - Day2Spec - Day3Spec - Day4Spec - Day5Spec - Paths_aoc2024 - - autogen-modules: Paths_aoc2024 - default-language: Haskell2010 - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - - build-depends: - QuickCheck >=2.14.3 && <2.15, - aoc2024, - base >=4.7 && <5, - containers, - hspec >=2.0.0, - regex-tdfa >=1.3.2 && <1.4, - text >=2.0.2, - unordered-containers + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Day1Spec + Day2Spec + Day3Spec + Day4Spec + Day5Spec + Day6Spec + Paths_aoc2024 + autogen-modules: + Paths_aoc2024 + hs-source-dirs: + test + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + QuickCheck >=2.14.3 && <2.15 + , aoc2024 + , base >=4.7 && <5 + , containers + , hashable + , hspec >=2.0.0 + , regex-tdfa >=1.3.2 && <1.4 + , text >=2.0.2 + , unordered-containers + default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 5d10926..dab6d6f 100644 --- a/package.yaml +++ b/package.yaml @@ -25,6 +25,7 @@ dependencies: - text >= 2.0.2 - containers - unordered-containers + - hashable ghc-options: - -Wall diff --git a/src/Day6.hs b/src/Day6.hs index e104b1b..395b1be 100644 --- a/src/Day6.hs +++ b/src/Day6.hs @@ -4,75 +4,59 @@ import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.Matrix (Matrix, Position) import qualified Data.Matrix as M -import Data.Maybe -import Prelude hiding (Left, Right) +import Day6.Guard (Guard (..)) +import qualified Day6.Guard as G -partOne :: String -> Maybe Int +data Error = GuardNotFoundError + deriving (Eq, Show) + +partOne :: String -> Either Error Int partOne input = length <$> predictGuardsRoute (parseLabMap input) -partTwo :: String -> Int -partTwo _input = 0 +partTwo :: String -> Either Error Int +partTwo _input = Right 0 -- Laboratory Map --- type LabMap = Matrix Char -type Direction = Char - -type Guard = (Position, Direction) - -type Visited = HashSet (Position, Direction) +type Visited = HashSet Guard parseLabMap :: String -> LabMap parseLabMap = M.buildMatrix . lines -findGuard :: LabMap -> Maybe Guard +findGuard :: LabMap -> Either Error Guard findGuard matrix = let mUp = M.lookupValue '^' matrix mDown = M.lookupValue 'v' matrix mRight = M.lookupValue '>' matrix mLeft = M.lookupValue '<' matrix in case [mUp, mDown, mRight, mLeft] of - [Just pos, _, _, _] -> Just (pos, '^') - [_, Just pos, _, _] -> Just (pos, 'v') - [_, _, Just pos, _] -> Just (pos, '>') - [_, _, _, Just pos] -> Just (pos, '<') - _ -> Nothing + [Just pos, _, _, _] -> Right (Guard pos G.Up) + [_, Just pos, _, _] -> Right (Guard pos G.Down) + [_, _, Just pos, _] -> Right (Guard pos G.Right) + [_, _, _, Just pos] -> Right (Guard pos G.Left) + _ -> Left GuardNotFoundError -predictGuardsRoute :: LabMap -> Maybe [Position] +predictGuardsRoute :: LabMap -> Either Error [Position] predictGuardsRoute labMap = do guard <- findGuard labMap - return (go guard HashSet.empty HashSet.empty) + return $ go guard HashSet.empty HashSet.empty where go :: Guard -> Visited -> HashSet Position -> [Position] - go guard@(position, _) visited acc = + go guard visited acc = let guard' = moveGuard guard - acc' = HashSet.insert position acc + acc' = HashSet.insert (position guard) acc visited' = HashSet.insert guard visited in -- If we have hit a loop or if the guard can't move anymore, finish prediction - if HashSet.member guard visited || guard == guard' + if HashSet.member guard visited || (guard == guard') then HashSet.toList acc' else go guard' visited' acc' moveGuard :: Guard -> Guard moveGuard guard = - let guard'@(position', _) = moveForward guard - mObstacle = M.lookup position' labMap + let guard' = G.moveForward guard + mObstacle = M.lookup (position guard') labMap in case mObstacle of Nothing -> guard - Just '#' -> turnRight guard + Just '#' -> G.turnRight guard Just _ -> guard' - - moveForward :: Guard -> Guard - moveForward ((row, col), '^') = ((row - 1, col), '^') - moveForward ((row, col), 'v') = ((row + 1, col), 'v') - moveForward ((row, col), '>') = ((row, col + 1), '>') - moveForward ((row, col), '<') = ((row, col - 1), '<') - moveForward guard = guard - - turnRight :: Guard -> Guard - turnRight (pos, '^') = (pos, '>') - turnRight (pos, '>') = (pos, 'v') - turnRight (pos, 'v') = (pos, '<') - turnRight (pos, '<') = (pos, '^') - turnRight guard = guard diff --git a/src/Day6/Guard.hs b/src/Day6/Guard.hs new file mode 100644 index 0000000..7276a45 --- /dev/null +++ b/src/Day6/Guard.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Day6.Guard (Guard (..), Direction (..), moveForward, turnRight) where + +import Data.Hashable +import Data.Matrix (Position) +import GHC.Generics (Generic) +import Prelude hiding (Left, Right) + +data Direction = Up | Down | Left | Right + deriving (Eq, Generic) + +instance Hashable Direction + +data Guard = Guard {position :: Position, directon :: Direction} + deriving (Eq, Generic) + +instance Hashable Guard + +moveForward :: Guard -> Guard +moveForward (Guard (row, col) Up) = Guard (row - 1, col) Up +moveForward (Guard (row, col) Down) = Guard (row + 1, col) Down +moveForward (Guard (row, col) Right) = Guard (row, col + 1) Right +moveForward (Guard (row, col) Left) = Guard (row, col - 1) Left + +turnRight :: Guard -> Guard +turnRight (Guard pos Up) = Guard pos Right +turnRight (Guard pos Right) = Guard pos Down +turnRight (Guard pos Down) = Guard pos Left +turnRight (Guard pos Left) = Guard pos Up diff --git a/test/Day6Spec.hs b/test/Day6Spec.hs new file mode 100644 index 0000000..2d2e74d --- /dev/null +++ b/test/Day6Spec.hs @@ -0,0 +1,26 @@ +module Day6Spec (spec) where + +import Day6 (partOne, partTwo) +import Test.Hspec + +spec :: Spec +spec = do + describe "PartOne" $ do + it "works" $ do + partOne input `shouldBe` Right 41 + + describe "PartTwo" $ do + it "works" $ do + partTwo input `shouldBe` Right 6 + where + input = + "....#.....\n\ + \.........#\n\ + \..........\n\ + \..#.......\n\ + \.......#..\n\ + \..........\n\ + \.#..^.....\n\ + \........#.\n\ + \#.........\n\ + \......#..."