Skip to content

Commit c27e24e

Browse files
JasterVJasterV
committed
refactor day6 part one
1 parent 1648683 commit c27e24e

File tree

5 files changed

+148
-106
lines changed

5 files changed

+148
-106
lines changed

‎aoc2024.cabal‎

Lines changed: 68 additions & 67 deletions
Original file line numberDiff line numberDiff line change
@@ -1,77 +1,78 @@
1-
cabal-version: 2.2
2-
name: aoc2024
3-
version: 0.1.0.0
4-
license: BSD-3-Clause
5-
license-file: LICENSE
6-
copyright: 2025 Author name here
7-
maintainer: example@example.com
8-
author: Author name here
9-
homepage: https://github.com/githubuser/aoc2024#readme
10-
bug-reports: https://github.com/githubuser/aoc2024/issues
11-
description:
12-
Please see the README on GitHub at <https://github.com/githubuser/aoc2024#readme>
1+
cabal-version: 2.2
132

14-
build-type: Simple
3+
-- This file has been generated from package.yaml by hpack version 0.37.0.
4+
--
5+
-- see: https://github.com/sol/hpack
6+
7+
name: aoc2024
8+
version: 0.1.0.0
9+
description: Please see the README on GitHub at <https://github.com/githubuser/aoc2024#readme>
10+
homepage: https://github.com/githubuser/aoc2024#readme
11+
bug-reports: https://github.com/githubuser/aoc2024/issues
12+
author: Author name here
13+
maintainer: example@example.com
14+
copyright: 2025 Author name here
15+
license: BSD-3-Clause
16+
license-file: LICENSE
17+
build-type: Simple
1518
extra-source-files:
1619
README.md
1720
CHANGELOG.md
1821

1922
source-repository head
20-
type: git
21-
location: https://github.com/githubuser/aoc2024
23+
type: git
24+
location: https://github.com/githubuser/aoc2024
2225

2326
library
24-
exposed-modules:
25-
Data.Matrix
26-
Day1
27-
Day2
28-
Day3
29-
Day4
30-
Day5
31-
Day6
32-
33-
hs-source-dirs: src
34-
other-modules: Paths_aoc2024
35-
autogen-modules: Paths_aoc2024
36-
default-language: Haskell2010
37-
ghc-options:
38-
-Wall -Wcompat -Widentities -Wincomplete-record-updates
39-
-Wincomplete-uni-patterns -Wmissing-export-lists
40-
-Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
41-
42-
build-depends:
43-
base >=4.7 && <5,
44-
containers,
45-
regex-tdfa >=1.3.2 && <1.4,
46-
text >=2.0.2,
47-
unordered-containers
27+
exposed-modules:
28+
Data.Matrix
29+
Day1
30+
Day2
31+
Day3
32+
Day4
33+
Day5
34+
Day6
35+
Day6.Guard
36+
other-modules:
37+
Paths_aoc2024
38+
autogen-modules:
39+
Paths_aoc2024
40+
hs-source-dirs:
41+
src
42+
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
43+
build-depends:
44+
base >=4.7 && <5
45+
, containers
46+
, hashable
47+
, regex-tdfa >=1.3.2 && <1.4
48+
, text >=2.0.2
49+
, unordered-containers
50+
default-language: Haskell2010
4851

4952
test-suite aoc2024-test
50-
type: exitcode-stdio-1.0
51-
main-is: Spec.hs
52-
hs-source-dirs: test
53-
other-modules:
54-
Day1Spec
55-
Day2Spec
56-
Day3Spec
57-
Day4Spec
58-
Day5Spec
59-
Paths_aoc2024
60-
61-
autogen-modules: Paths_aoc2024
62-
default-language: Haskell2010
63-
ghc-options:
64-
-Wall -Wcompat -Widentities -Wincomplete-record-updates
65-
-Wincomplete-uni-patterns -Wmissing-export-lists
66-
-Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
67-
-threaded -rtsopts -with-rtsopts=-N
68-
69-
build-depends:
70-
QuickCheck >=2.14.3 && <2.15,
71-
aoc2024,
72-
base >=4.7 && <5,
73-
containers,
74-
hspec >=2.0.0,
75-
regex-tdfa >=1.3.2 && <1.4,
76-
text >=2.0.2,
77-
unordered-containers
53+
type: exitcode-stdio-1.0
54+
main-is: Spec.hs
55+
other-modules:
56+
Day1Spec
57+
Day2Spec
58+
Day3Spec
59+
Day4Spec
60+
Day5Spec
61+
Day6Spec
62+
Paths_aoc2024
63+
autogen-modules:
64+
Paths_aoc2024
65+
hs-source-dirs:
66+
test
67+
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
68+
build-depends:
69+
QuickCheck >=2.14.3 && <2.15
70+
, aoc2024
71+
, base >=4.7 && <5
72+
, containers
73+
, hashable
74+
, hspec >=2.0.0
75+
, regex-tdfa >=1.3.2 && <1.4
76+
, text >=2.0.2
77+
, unordered-containers
78+
default-language: Haskell2010

‎package.yaml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ dependencies:
2525
- text >= 2.0.2
2626
- containers
2727
- unordered-containers
28+
- hashable
2829

2930
ghc-options:
3031
- -Wall

‎src/Day6.hs‎

Lines changed: 23 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -4,75 +4,59 @@ import Data.HashSet (HashSet)
44
import qualified Data.HashSet as HashSet
55
import Data.Matrix (Matrix, Position)
66
import qualified Data.Matrix as M
7-
import Data.Maybe
8-
import Prelude hiding (Left, Right)
7+
import Day6.Guard (Guard (..))
8+
import qualified Day6.Guard as G
99

10-
partOne :: String -> Maybe Int
10+
data Error = GuardNotFoundError
11+
deriving (Eq, Show)
12+
13+
partOne :: String -> Either Error Int
1114
partOne input = length <$> predictGuardsRoute (parseLabMap input)
1215

13-
partTwo :: String -> Int
14-
partTwo _input = 0
16+
partTwo :: String -> Either Error Int
17+
partTwo _input = Right 0
1518

1619
-- Laboratory Map
17-
--
1820
type LabMap = Matrix Char
1921

20-
type Direction = Char
21-
22-
type Guard = (Position, Direction)
23-
24-
type Visited = HashSet (Position, Direction)
22+
type Visited = HashSet Guard
2523

2624
parseLabMap :: String -> LabMap
2725
parseLabMap = M.buildMatrix . lines
2826

29-
findGuard :: LabMap -> Maybe Guard
27+
findGuard :: LabMap -> Either Error Guard
3028
findGuard matrix =
3129
let mUp = M.lookupValue '^' matrix
3230
mDown = M.lookupValue 'v' matrix
3331
mRight = M.lookupValue '>' matrix
3432
mLeft = M.lookupValue '<' matrix
3533
in case [mUp, mDown, mRight, mLeft] of
36-
[Just pos, _, _, _] -> Just (pos, '^')
37-
[_, Just pos, _, _] -> Just (pos, 'v')
38-
[_, _, Just pos, _] -> Just (pos, '>')
39-
[_, _, _, Just pos] -> Just (pos, '<')
40-
_ -> Nothing
34+
[Just pos, _, _, _] -> Right (Guard pos G.Up)
35+
[_, Just pos, _, _] -> Right (Guard pos G.Down)
36+
[_, _, Just pos, _] -> Right (Guard pos G.Right)
37+
[_, _, _, Just pos] -> Right (Guard pos G.Left)
38+
_ -> Left GuardNotFoundError
4139

42-
predictGuardsRoute :: LabMap -> Maybe [Position]
40+
predictGuardsRoute :: LabMap -> Either Error [Position]
4341
predictGuardsRoute labMap = do
4442
guard <- findGuard labMap
45-
return (go guard HashSet.empty HashSet.empty)
43+
return $ go guard HashSet.empty HashSet.empty
4644
where
4745
go :: Guard -> Visited -> HashSet Position -> [Position]
48-
go guard@(position, _) visited acc =
46+
go guard visited acc =
4947
let guard' = moveGuard guard
50-
acc' = HashSet.insert position acc
48+
acc' = HashSet.insert (position guard) acc
5149
visited' = HashSet.insert guard visited
5250
in -- If we have hit a loop or if the guard can't move anymore, finish prediction
53-
if HashSet.member guard visited || guard == guard'
51+
if HashSet.member guard visited || (guard == guard')
5452
then HashSet.toList acc'
5553
else go guard' visited' acc'
5654

5755
moveGuard :: Guard -> Guard
5856
moveGuard guard =
59-
let guard'@(position', _) = moveForward guard
60-
mObstacle = M.lookup position' labMap
57+
let guard' = G.moveForward guard
58+
mObstacle = M.lookup (position guard') labMap
6159
in case mObstacle of
6260
Nothing -> guard
63-
Just '#' -> turnRight guard
61+
Just '#' -> G.turnRight guard
6462
Just _ -> guard'
65-
66-
moveForward :: Guard -> Guard
67-
moveForward ((row, col), '^') = ((row - 1, col), '^')
68-
moveForward ((row, col), 'v') = ((row + 1, col), 'v')
69-
moveForward ((row, col), '>') = ((row, col + 1), '>')
70-
moveForward ((row, col), '<') = ((row, col - 1), '<')
71-
moveForward guard = guard
72-
73-
turnRight :: Guard -> Guard
74-
turnRight (pos, '^') = (pos, '>')
75-
turnRight (pos, '>') = (pos, 'v')
76-
turnRight (pos, 'v') = (pos, '<')
77-
turnRight (pos, '<') = (pos, '^')
78-
turnRight guard = guard

‎src/Day6/Guard.hs‎

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
{-# LANGUAGE DeriveGeneric #-}
2+
3+
module Day6.Guard (Guard (..), Direction (..), moveForward, turnRight) where
4+
5+
import Data.Hashable
6+
import Data.Matrix (Position)
7+
import GHC.Generics (Generic)
8+
import Prelude hiding (Left, Right)
9+
10+
data Direction = Up | Down | Left | Right
11+
deriving (Eq, Generic)
12+
13+
instance Hashable Direction
14+
15+
data Guard = Guard {position :: Position, directon :: Direction}
16+
deriving (Eq, Generic)
17+
18+
instance Hashable Guard
19+
20+
moveForward :: Guard -> Guard
21+
moveForward (Guard (row, col) Up) = Guard (row - 1, col) Up
22+
moveForward (Guard (row, col) Down) = Guard (row + 1, col) Down
23+
moveForward (Guard (row, col) Right) = Guard (row, col + 1) Right
24+
moveForward (Guard (row, col) Left) = Guard (row, col - 1) Left
25+
26+
turnRight :: Guard -> Guard
27+
turnRight (Guard pos Up) = Guard pos Right
28+
turnRight (Guard pos Right) = Guard pos Down
29+
turnRight (Guard pos Down) = Guard pos Left
30+
turnRight (Guard pos Left) = Guard pos Up

‎test/Day6Spec.hs‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
module Day6Spec (spec) where
2+
3+
import Day6 (partOne, partTwo)
4+
import Test.Hspec
5+
6+
spec :: Spec
7+
spec = do
8+
describe "PartOne" $ do
9+
it "works" $ do
10+
partOne input `shouldBe` Right 41
11+
12+
describe "PartTwo" $ do
13+
it "works" $ do
14+
partTwo input `shouldBe` Right 6
15+
where
16+
input =
17+
"....#.....\n\
18+
\.........#\n\
19+
\..........\n\
20+
\..#.......\n\
21+
\.......#..\n\
22+
\..........\n\
23+
\.#..^.....\n\
24+
\........#.\n\
25+
\#.........\n\
26+
\......#..."

0 commit comments

Comments
 (0)