1 {-# LANGUAGE NegativeLiterals #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE TypeFamilies #-}
6 import Prelude hiding ((++))
7 import Data.Text (Text)
8 import qualified Data.Text as T
9 import qualified Data.Text.IO as TIO
11 import Text.Megaparsec hiding (State)
12 import qualified Text.Megaparsec.Lexer as L
13 import Text.Megaparsec.Text (Parser)
14 import qualified Control.Applicative as CA
16 import Control.Monad.State.Lazy
17 import Control.Monad.Reader
19 import Data.Vector.Unboxed ((!), (++), (//))
20 import qualified Data.Vector.Unboxed as V
22 import qualified Data.IntMap as M
30 type Dancers = V.Vector Char
32 type DanceHistory = M.IntMap Dancers
34 type HistoryRecorder = ReaderT [Step] (State DanceHistory) DanceHistory
37 startingDancers :: Dancers
38 startingDancers = V.fromList ['a'..'p']
40 emptyHistory :: DanceHistory
41 emptyHistory = M.singleton 0 startingDancers
46 text <- TIO.readFile "data/advent16.txt"
47 let instrs = successfulParse text
52 part1 :: [Step] -> Dancers
53 part1 instrs = evalState (runDance instrs) startingDancers
55 part2 instrs = (M.!) history (1000000000 `rem` M.size history)
56 where history = evalState (runReaderT (recordDance startingDancers) instrs) emptyHistory
59 runDance :: [Step] -> State Dancers Dancers
60 runDance [] = do dancers <- get
62 runDance (step:steps) =
64 let dancers' = case step of
65 Spin n -> spin n dancers
66 Exchange a b -> exchange a b dancers
67 Partner a b -> partner a b dancers
72 recordDance :: Dancers -> HistoryRecorder
77 let dancers' = evalState (runDance instrs) dancers
78 if dancers' == startingDancers && (not (history == emptyHistory))
82 -- let dancers' = evalState (runDance instrs) dancers
83 let history' = M.insert (M.size history) dancers' history
87 spin :: Int -> Dancers -> Dancers
88 spin n dancers = back ++ front
89 where (front, back) = V.splitAt n' dancers
90 n' = V.length dancers - n
92 exchange :: Int -> Int -> Dancers -> Dancers
93 exchange a b dancers = dancers // [(a, dancers!b), (b, dancers!a)]
95 partner :: Char -> Char -> Dancers -> Dancers
96 partner a b dancers = exchange a' b' dancers
97 where a' = V.head $ V.elemIndices a dancers
98 b' = V.head $ V.elemIndices b dancers
102 sc = L.space (skipSome spaceChar) CA.empty CA.empty
104 -- lexeme = L.lexeme sc
107 int = read <$> some digitChar
111 dancer = oneOf ['a'..'p']
113 stepsP = stepP `sepBy` comma
114 stepP = (try spinP) <|> (try exchangeP) <|> partnerP
116 spinP = Spin <$> (symb "s" *> int)
117 exchangeP = Exchange <$> (symb "x" *> int) <*> (symb "/" *> int)
118 partnerP = Partner <$> (symb "p" *> dancer) <*> (symb "/" *> dancer)
120 successfulParse :: Text -> [Step]
121 successfulParse input =
122 case parse stepsP "input" input of
123 Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err