Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 64fbdb8

Browse files
committed
day 25 rewritten with graduitious traversals and semigroups
1 parent ac8a6ef commit 64fbdb8

File tree

2 files changed

+64
-64
lines changed

2 files changed

+64
-64
lines changed

‎src/AOC2017.hs

Lines changed: 31 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,7 @@ import Control.Monad.IO.Class
4646
import Control.Monad.Trans.Except
4747
import Data.Foldable
4848
import Data.List
49+
import Data.Monoid
4950
import GHC.Generics (Generic)
5051
import Network.Curl
5152
import System.FilePath
@@ -59,36 +60,37 @@ import qualified Data.Yaml as Y
5960

6061
challengeMap :: IM.IntMap (M.Map Char Challenge)
6162
challengeMap = IM.fromList
62-
[ (d, M.fromList [('a', ca),('b', cb)])
63-
| (d, (ca, cb)) <- challenges
63+
[ (d, M.fromList (zip ['a'..] ps))
64+
| (d, ps) <- challenges
6465
]
65-
66-
challenges :: [(Int, (Challenge, Challenge))]
67-
challenges = [ ( 1, (day01a, day01b))
68-
, ( 2, (day02a, day02b))
69-
, ( 3, (day03a, day03b))
70-
, ( 4, (day04a, day04b))
71-
, ( 5, (day05a, day05b))
72-
, ( 6, (day06a, day06b))
73-
, ( 7, (day07a, day07b))
74-
, ( 8, (day08a, day08b))
75-
, ( 9, (day09a, day09b))
76-
, (10, (day10a, day10b))
77-
, (11, (day11a, day11b))
78-
, (12, (day12a, day12b))
79-
, (13, (day13a, day13b))
80-
, (14, (day14a, day14b))
81-
, (15, (day15a, day15b))
82-
, (16, (day16a, day16b))
83-
, (17, (day17a, day17b))
84-
, (18, (day18a, day18b))
85-
, (19, (day19a, day19b))
86-
, (20, (day20a, day20b))
87-
, (21, (day21a, day21b))
88-
, (22, (day22a, day22b))
89-
, (23, (day23a, day23b))
90-
, (24, (day24a, day24b))
91-
, (25, (day25a, day25b))
66+
<> IM.singleton 25 (M.singleton 'a' day25a)
67+
68+
challenges :: [(Int, [Challenge])]
69+
challenges = [ ( 1, [day01a, day01b])
70+
, ( 2, [day02a, day02b])
71+
, ( 3, [day03a, day03b])
72+
, ( 4, [day04a, day04b])
73+
, ( 5, [day05a, day05b])
74+
, ( 6, [day06a, day06b])
75+
, ( 7, [day07a, day07b])
76+
, ( 8, [day08a, day08b])
77+
, ( 9, [day09a, day09b])
78+
, (10, [day10a, day10b])
79+
, (11, [day11a, day11b])
80+
, (12, [day12a, day12b])
81+
, (13, [day13a, day13b])
82+
, (14, [day14a, day14b])
83+
, (15, [day15a, day15b])
84+
, (16, [day16a, day16b])
85+
, (17, [day17a, day17b])
86+
, (18, [day18a, day18b])
87+
, (19, [day19a, day19b])
88+
, (20, [day20a, day20b])
89+
, (21, [day21a, day21b])
90+
, (22, [day22a, day22b])
91+
, (23, [day23a, day23b])
92+
, (24, [day24a, day24b])
93+
, (25, [day25a ])
9294
]
9395

9496
data ChallengePaths = CP { _cpDataUrl :: !FilePath

‎src/AOC2017/Day25.hs

Lines changed: 33 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -1,43 +1,41 @@
1-
module AOC2017.Day25 (day25a, day25b) where
1+
module AOC2017.Day25 (day25a) where
22

3-
import AOC2017.Types (Challenge)
4-
import AOC2017.Util
5-
import Control.Lens
6-
import qualified Data.IntSet as IS
3+
import AOC2017.Types (Challenge)
4+
import AOC2017.Util ((!!!))
5+
import Control.Lens hiding ((<>~))
6+
import Data.Coerce
7+
import Data.Semigroup
8+
import qualified Data.IntSet as IS
9+
import qualified Data.Map as M
710

8-
data St = SA | SB | SC | SD | SE | SF
11+
type St = Last Char
12+
type Step = (Sum Int, St)
13+
type RuleMap = M.Map St ((Step, Bool), (Step, Bool))
914

10-
data Dir = DL | DR
15+
runRule :: RuleMap -> St -> Bool -> (Step, Bool)
16+
runRule rm st = \case
17+
False -> fst $ rm M.! st
18+
True -> snd $ rm M.! st
1119

12-
type Rule = (Bool, Dir, St)
20+
step :: RuleMap -> (Step, IS.IntSet) -> (Step, IS.IntSet)
21+
step rm (s0@(Sum i,st),t) = t & contains i %%~ runRule rm st
22+
& _1 %~ (s0 <>)
1323

14-
type TapeState = (Int, IS.IntSet, St)
15-
16-
rule :: St -> (Rule, Rule)
17-
rule = \case
18-
SA -> ((True, DR, SB), (False, DR, SF))
19-
SB -> ((False,DL, SB), (True, DL, SC))
20-
SC -> ((True,DL,SD),(False, DR, SC))
21-
SD -> ((True, DL, SE),(True, DR, SA))
22-
SE -> ((True, DL, SF), (False, DL, SD))
23-
SF -> ((True, DR, SA), (False, DL, SE))
24+
day25a :: Challenge
25+
day25a _ = show . IS.size . snd
26+
. (!!! 12964419)
27+
. iterate (step ruleMap)
28+
$ ((0, Last 'a'), mempty)
2429

25-
step :: TapeState->TapeState
26-
step (!i0, !t0, !st0) = (i1, t1, st1)
30+
ruleMap :: RuleMap
31+
ruleMap =M.fromList (coerce ruleList)
2732
where
28-
i1 = case dirTurn of
29-
DL -> i0 - 1
30-
DR -> i0 + 1
31-
t1 = t0 & if newFoc
32-
then IS.insert i0
33-
else IS.delete i0
34-
(newFoc, dirTurn, st1)
35-
| i0 `IS.member` t0 = snd (rule st0)
36-
| otherwise = fst (rule st0)
37-
38-
day25a :: Challenge
39-
day25a _ = show . IS.size . view _2
40-
$ iterate step (0, IS.empty, SA) !!! 12964419
33+
ruleList :: [(Char, (((Int, Char), Bool), ((Int, Char), Bool)))]
34+
ruleList = [ ('a', ((( 1, 'b'), True ), (( 1, 'f'), False)))
35+
, ('b', (((-1, 'b'), False), ((-1, 'c'), True )))
36+
, ('c', (((-1, 'd'), True ), (( 1, 'c'), False)))
37+
, ('d', (((-1, 'e'), True ), (( 1, 'a'), True )))
38+
, ('e', (((-1, 'f'), True ), ((-1, 'd'), False)))
39+
, ('f', ((( 1, 'a'), True ), ((-1, 'e'), False)))
40+
]
4141

42-
day25b :: Challenge
43-
day25b _ = "Merry Christmas!"

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /