{-|
Module:         Day21
Description:    <https://adventofcode.com/2021/day/21 Day 21: Dirac Dice>
-}
{-# LANGUAGE FlexibleContexts, OverloadedStrings, TypeFamilies #-}
module Day21 (day21a, day21b) where

import Control.Monad (guard, join, replicateM)
import Data.Array ((!), listArray, range)
import qualified Data.IntMap as IntMap (assocs, fromListWith)
import Data.String (IsString)
import Data.Text (Text)
import Data.Void (Void)
import Text.Megaparsec (MonadParsec, ParseErrorBundle, Token, Tokens, between, chunk, parse)
import Text.Megaparsec.Char (newline)
import Text.Megaparsec.Char.Lexer (decimal)

parser :: (MonadParsec e s m, IsString (Tokens s), Token s ~ Char) => m (Int, Int)
parser :: m (Int, Int)
parser = (,) (Int -> Int -> (Int, Int)) -> m Int -> m (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    m (Tokens s) -> m Char -> m Int -> m Int
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"Player 1 starting position: ") m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal m (Int -> (Int, Int)) -> m Int -> m (Int, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    m (Tokens s) -> m Char -> m Int -> m Int
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"Player 2 starting position: ") m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal

day21a :: Text -> Either (ParseErrorBundle Text Void) Int
day21a :: Text -> Either (ParseErrorBundle Text Void) Int
day21a Text
input = do
    (Int
p1, Int
p2) <- Parsec Void Text (Int, Int)
-> String -> Text -> Either (ParseErrorBundle Text Void) (Int, Int)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text (Int, Int)
forall e s (m :: * -> *).
(MonadParsec e s m, IsString (Tokens s), Token s ~ Char) =>
m (Int, Int)
parser String
"" Text
input
    Int -> Either (ParseErrorBundle Text Void) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either (ParseErrorBundle Text Void) Int)
-> Int -> Either (ParseErrorBundle Text Void) Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ do
        ((Int
_, Int
_, Int
s1, Int
s2), Int
n) <- ([Int] -> [Int] -> [((Int, Int, Int, Int), Int)])
-> [Int] -> [((Int, Int, Int, Int), Int)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([(Int, Int, Int, Int)] -> [Int] -> [((Int, Int, Int, Int), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(Int, Int, Int, Int)] -> [Int] -> [((Int, Int, Int, Int), Int)])
-> ([Int] -> [(Int, Int, Int, Int)])
-> [Int]
-> [Int]
-> [((Int, Int, Int, Int), Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int, Int, Int) -> Int -> (Int, Int, Int, Int))
-> (Int, Int, Int, Int) -> [Int] -> [(Int, Int, Int, Int)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (Int, Int, Int, Int) -> Int -> (Int, Int, Int, Int)
forall d a c. Integral d => (d, a, d, c) -> d -> (a, d, c, d)
f (Int
p1, Int
p2, Int
0, Int
0)) [Int
0, Int
3..]
        Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s1 Int -> [()] -> [Int]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
s2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1000)
  where
    f :: (d, a, d, c) -> d -> (a, d, c, d)
f (d
p1, a
p2, d
s1, c
s2) d
n = (a
p2, d
k, c
s2, d
s1 d -> d -> d
forall a. Num a => a -> a -> a
+ d
k) where
        k :: d
k = (d
p1 d -> d -> d
forall a. Num a => a -> a -> a
+ d
n d -> d -> d
forall a. Integral a => a -> a -> a
`mod` d
100 d -> d -> d
forall a. Num a => a -> a -> a
+ (d
n d -> d -> d
forall a. Num a => a -> a -> a
+ d
1) d -> d -> d
forall a. Integral a => a -> a -> a
`mod` d
100 d -> d -> d
forall a. Num a => a -> a -> a
+ (d
n d -> d -> d
forall a. Num a => a -> a -> a
+ d
2) d -> d -> d
forall a. Integral a => a -> a -> a
`mod` d
100 d -> d -> d
forall a. Num a => a -> a -> a
+ d
2) d -> d -> d
forall a. Integral a => a -> a -> a
`mod` d
10 d -> d -> d
forall a. Num a => a -> a -> a
+ d
1

day21b :: Text -> Either (ParseErrorBundle Text Void) Int
day21b :: Text -> Either (ParseErrorBundle Text Void) Int
day21b Text
input = do
    (Int
p1, Int
p2) <- Parsec Void Text (Int, Int)
-> String -> Text -> Either (ParseErrorBundle Text Void) (Int, Int)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text (Int, Int)
forall e s (m :: * -> *).
(MonadParsec e s m, IsString (Tokens s), Token s ~ Char) =>
m (Int, Int)
parser String
"" Text
input
    Int -> Either (ParseErrorBundle Text Void) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either (ParseErrorBundle Text Void) Int)
-> Int -> Either (ParseErrorBundle Text Void) Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Array (Int, Int, Int, Int) (Int, Int)
scores Array (Int, Int, Int, Int) (Int, Int)
-> (Int, Int, Int, Int) -> (Int, Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
p1, Int
p2, Int
0 :: Int, Int
0 :: Int)
  where
    scores :: Array (Int, Int, Int, Int) (Int, Int)
scores = ((Int, Int, Int, Int), (Int, Int, Int, Int))
-> [(Int, Int)] -> Array (Int, Int, Int, Int) (Int, Int)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
1, Int
1, Int
0, Int
0), (Int
10, Int
10, Int
20, Int
20))
      [ ((Int, Int) -> (Int, Int) -> (Int, Int))
-> (Int, Int) -> [(Int, Int)] -> (Int, Int)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Int) -> (Int, Int) -> (Int, Int)
forall a b. (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
add2 (Int
0, Int
0)
          [ if Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
21 then (Int
n, Int
0) else (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)
          | (Int
d, Int
n) <- IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
IntMap.assocs (IntMap Int -> [(Int, Int)]) -> IntMap Int -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> [(Int, Int)] -> IntMap Int
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
                [(Int
d, Int
1) | Int
d <- [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [[Int]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Int] -> [[Int]]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 [Int
1..Int
3]]
          , let k :: Int
k = (Int
p1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                (Int
x, Int
y) = Array (Int, Int, Int, Int) (Int, Int)
scores Array (Int, Int, Int, Int) (Int, Int)
-> (Int, Int, Int, Int) -> (Int, Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
p2, Int
k, Int
s2, Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k)
          ]
      | (Int
p1, Int
p2, Int
s1, Int
s2) <- ((Int, Int, Int, Int), (Int, Int, Int, Int))
-> [(Int, Int, Int, Int)]
forall a. Ix a => (a, a) -> [a]
range ((Int
1, Int
1, Int
0, Int
0), (Int
10, Int
10, Int
20, Int
20))
      ]
    add2 :: (a, b) -> (a, b) -> (a, b)
add2 (a
a, b
b) (a
c, b
d) = (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
c, b
b b -> b -> b
forall a. Num a => a -> a -> a
+ b
d)