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 869b47b

Browse files
committed
initial day 25. merry christmas!
1 parent 29ea1bd commit 869b47b

File tree

2 files changed

+56
-2
lines changed

2 files changed

+56
-2
lines changed

‎src/AOC2017/Day25.hs‎

Lines changed: 45 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,52 @@
11
module AOC2017.Day25 (day25a, day25b) where
22

3-
import AOC2017.Types (Challenge)
3+
import AOC2017.Types (Challenge)
4+
import AOC2017.Util
5+
import AOC2017.Util.Tape
6+
import Control.Lens
7+
import Control.Monad.Trans.Maybe
8+
import Control.Monad.Trans.State
9+
import Control.Monad.Trans.Writer
10+
import Data.Foldable
11+
import qualified Data.IntMap as IM
12+
import qualified Data.IntSet as IS
13+
import qualified Data.Map as M
14+
import qualified Data.Set as S
15+
import qualified Text.Megaparsec as P
16+
import qualified Text.Megaparsec.Char as P
17+
18+
data St = SA | SB | SC | SD | SE | SF
19+
20+
data Dir = DL | DR
21+
22+
type Rule = (Bool, Dir, St)
23+
24+
type TapeState = (Tape Bool, St)
25+
26+
27+
rule :: St -> (Rule, Rule)
28+
rule = \case
29+
SA -> ((True, DR, SB), (False, DR, SF))
30+
SB -> ((False,DL, SB), (True, DL, SC))
31+
SC -> ((True,DL,SD),(False, DR, SC))
32+
SD -> ((True, DL, SE),(True, DR, SA))
33+
SE -> ((True, DL, SF), (False, DL, SD))
34+
SF -> ((True, DR, SA), (False, DL, SE))
35+
36+
step :: TapeState -> TapeState
37+
step (!t0, !st0) = (t1, st1)
38+
where
39+
t1 = t0 & tFocus .~ newFoc
40+
& case dirTurn of
41+
DL -> moveLeftD False
42+
DR -> moveRightD False
43+
(newFoc, dirTurn, st1)
44+
| t0 ^. tFocus = snd (rule st0)
45+
| otherwise = fst (rule st0)
446

547
day25a :: Challenge
6-
day25a = undefined
48+
day25a _ = show . length . filter id . toList . fst
49+
$ iterate step (Tape [] False [], SA ) !!! 12964419
750

851
day25b :: Challenge
952
day25b = undefined

‎src/AOC2017/Util/Tape.hs‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ module AOC2017.Util.Tape (
1212
, move
1313
, moveLeftC, moveRightC
1414
, moveC
15+
, moveRightD, moveLeftD
1516
) where
1617

1718
import AOC2017.Util
@@ -90,3 +91,13 @@ moveC n = case compare n 0 of
9091
LT -> (!!! abs n) . iterate moveLeftC
9192
EQ -> id
9293
GT -> (!!! n ) . iterate moveRightC
94+
95+
moveLeftD :: a -> Tape a -> Tape a
96+
moveLeftD d (Tape ls x rs) = case ls of
97+
[] -> Tape [] d (x:rs)
98+
l:ls' -> Tape ls' l (x:rs)
99+
100+
moveRightD :: a -> Tape a -> Tape a
101+
moveRightD d (Tape ls x rs) = case rs of
102+
[] -> Tape (x:ls) d []
103+
r:rs' -> Tape (x:ls) r rs'

0 commit comments

Comments
(0)

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