advent22/src/advent22.hs

   1 -- import Debug.Trace
   2
   3 import Data.Text (Text)
   4 import qualified Data.Text.IO as TIO
   5
   6 import Data.Void (Void)
   7
   8 import Text.Megaparsec hiding (State)
   9 import Text.Megaparsec.Char
  10 import qualified Text.Megaparsec.Char.Lexer as L
  11 import qualified Control.Applicative as CA
  12
  13
  14 import Data.Finite (Finite, modulo, getFinite)
  15 import Data.Group (Group(..), pow)
  16 import GHC.TypeNats (KnownNat)
  17
  18 import Data.Foldable (fold)
  19
  20
  21 data ShuffleOp = Cut Integer
  22                | Increment Integer
  23                | Stack
  24                deriving (Eq, Ord, Show)
  25
  26 type Shuffle = [ShuffleOp]
  27
  28 data Affine n = Affine { affA :: !(Finite n)
  29                        , affB :: !(Finite n)
  30                        } deriving (Eq, Ord, Show)
  31
  32
  33 instance KnownNat n => Semigroup (Affine n) where
  34     Affine a2 b2 <> Affine a1 b1 = Affine (a2 * a1) (a2 * b1 + b2)
  35
  36 instance KnownNat n => Monoid (Affine n) where
  37     mempty = Affine 1 0
  38
  39 instance KnownNat n => Group (Affine n) where
  40     invert (Affine a b) = Affine a' b'
  41         where
  42         a' = a ^ (maxBound @(Finite n) - 1)
  43         b' = negate (a' * b)
  44
  45
  46 main :: IO ()
  47 main = do
  48         text <- TIO.readFile "data/advent22.txt"
  49         let shuffle = successfulParse text
  50         print $ part1 shuffle
  51         print $ part2 shuffle
  52
  53
  54 part1 shuffle = getFinite $ trans @$ 2019
  55     where trans = mergeOps $ map affOfOp shuffle :: Affine 10007
  56
  57 part2 shuffle = getFinite $ invert bigTrans @$ 2020
  58     where trans = mergeOps $ map affOfOp shuffle :: Affine 119315717514047
  59           bigTrans = trans `pow` 101741582076661
  60
  61
  62
  63 affOfOp :: KnownNat n => ShuffleOp -> Affine n
  64 affOfOp (Cut c) = Affine 1 (negate (modulo c))
  65 affOfOp (Increment i) = Affine (modulo i) 0
  66 affOfOp Stack = Affine (modulo -1) (modulo -1)
  67
  68 mergeOps :: KnownNat n => [Affine n] -> Affine n
  69 mergeOps = fold . reverse
  70
  71 -- given a transformation, where does the item at x end up?
  72 (@$) :: KnownNat n => Affine n -> Finite n -> Finite n
  73 Affine a b @$ x = a * x + b
  74
  75
  76 -- Parse the input file
  77 type Parser = Parsec Void Text
  78
  79 sc :: Parser ()
  80 sc = L.space (skipSome spaceChar) CA.empty CA.empty
  81 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
  82
  83 lexeme  = L.lexeme sc
  84 integer = lexeme L.decimal
  85 signedInteger = L.signed sc integer
  86 symb = L.symbol sc
  87 cutSP = symb "cut"
  88 dealIncrementP = symb "deal with increment"
  89 dealIntoP = symb "deal into new stack"
  90
  91 cutP = Cut <$> (cutSP *> signedInteger)
  92 incrementP = Increment <$> (dealIncrementP *> signedInteger)
  93 stackP = Stack <$ dealIntoP
  94
  95 shuffleOpP = cutP <|> incrementP <|> stackP
  96
  97 shuffleP = many shuffleOpP
  98
  99 -- successfulParse :: Text -> [Vec]
 100 successfulParse :: Text -> Shuffle
 101 successfulParse input =
 102         case parse shuffleP "input" input of
 103                 Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 104                 Right shuffle -> shuffle