module AOC.Challenge.Day17 (
day17a
, day17b
, runDay17
, ixPascal, ixPascalRef
, pascalIx
, encRun
, pascalVecRunIx
, vecRunIxPascal
, genVecRunIxPascal
, oldNeighborWeights
, vecRunNeighbs
, vecRunNeighbsInt
, vecRunNeighbs_
, neighborWeights
, finalWeight
, binom
, chompPascal
,ixChomper, ixChomperRef
) where
import AOC.Common (factorial, integerFactorial, freqs, lookupFreq, foldMapParChunk, strictIterate)
import AOC.Common.Point (Point, parseAsciiSet)
import AOC.Solver ((:~>)(..))
import Control.Applicative.Backwards (Backwards(..))
import Debug.Trace
import Control.DeepSeq (force, NFData)
import Control.Lens (itraverseOf)
import Control.Monad (when, guard)
import Control.Monad.ST (runST)
import Control.Monad.State (StateT(..))
import Data.Bifunctor (second)
import Data.Coerce (coerce)
import Data.Foldable (toList, for_)
import Data.IntMap.Strict (IntMap)
import Data.IntSet (IntSet)
import Data.List (scanl', sort, transpose)
import Data.Map (Map)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Set (Set)
import Data.Tuple.Strict (T3(..), T2(..))
import GHC.Generics (Generic)
import Linear (V2(..))
import Safe (lastMay)
import qualified Data.IntMap.Monoidal.Strict as MIM
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import qualified Data.Map as M
import qualified Data.MemoCombinators as Memo
import qualified Data.Set as S
import qualified Data.Vector as V
import qualified Data.Vector.Generic.Lens as V
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Unboxed as VU
pascalIx :: [Int] -> Int
pascalIx :: [Int] -> Int
pascalIx = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([Int] -> [Int]) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
p Int
x -> if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int -> Int -> Int
binom (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
x) (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) [Int
0..]
binom
:: Int
-> Int
-> Int
binom :: Int -> Int -> Int
binom Int
n Int
k = Int -> Int -> Int
go Int
1 Int
1
where
go :: Int -> Int -> Int
go Int
i !Int
x
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
k = Int -> Int -> Int
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
i)
| Bool
otherwise = Int
x
pascalVecRunIx :: VU.Vector Int -> Int
pascalVecRunIx :: Vector Int -> Int
pascalVecRunIx = ((Int, Int) -> [Int] -> Int) -> ((Int, Int), [Int]) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> (Int, Int) -> [Int] -> Int
go Int
0) (((Int, Int), [Int]) -> Int)
-> (Vector Int -> ((Int, Int), [Int])) -> Vector Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ((Int, Int), [Int])
forall {b} {a}. Num b => [a] -> ((a, b), [a])
prepro ([Int] -> ((Int, Int), [Int]))
-> (Vector Int -> [Int]) -> Vector Int -> ((Int, Int), [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Int -> [Int]
forall a. Unbox a => Vector a -> [a]
VU.toList
where
prepro :: [a] -> ((a, b), [a])
prepro ~(a
x:[a]
xs) = ((a
x, b
0), [a]
xs)
go :: Int -> (Int, Int) -> [Int] -> Int
go !Int
tot (!Int
i, !Int
j) = \case
[] -> Int
tot
Int
x:[Int]
xs ->
let cs :: Int
cs = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Int -> Int -> Int
binom (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k) Int
j | Int
k <- [Int
1..Int
x] ]
in Int -> (Int, Int) -> [Int] -> Int
go (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cs) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
xs
ixPascal
:: Int
-> Int
-> [Int]
ixPascal :: Int -> Int -> [Int]
ixPascal Int
n Int
x = Int -> Int -> [Int] -> [Int]
go Int
x Int
0 []
where
go :: Int -> Int -> [Int] -> [Int]
go :: Int -> Int -> [Int] -> [Int]
go Int
y Int
i [Int]
r
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = Int -> Int -> [Int] -> [Int]
go Int
y' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
s Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
r)
| Bool
otherwise = [Int]
r
where
(Int
y', Int
s) = Int -> Int -> (Int, Int)
ixChomper (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) Int
y
ixChomper :: Int -> Int -> (Int, Int)
ixChomper :: Int -> Int -> (Int, Int)
ixChomper Int
n Int
x = Int -> Int -> (Int, Int)
go Int
0 Int
0
where
go :: Int -> Int -> (Int, Int)
go Int
k Int
z
| Int
z' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
x = (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
z, Int
k)
| Bool
otherwise = Int -> Int -> (Int, Int)
go (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
z'
where
z' :: Int
z' = Int -> Int -> Int
binom (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k) Int
n
ixPascalRef
:: Int
-> Int
-> [Int]
ixPascalRef :: Int -> Int -> [Int]
ixPascalRef Int
n Int
x = Int -> Int -> [Int] -> [Int]
go Int
x Int
0 []
where
go :: Int -> Int -> [Int] -> [Int]
go :: Int -> Int -> [Int] -> [Int]
go Int
y Int
i [Int]
r
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = Int -> Int -> [Int] -> [Int]
go (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall a. [a] -> a
last [Int]
qs) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
qs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
r)
| Bool
otherwise = [Int]
r
where
qs :: [Int]
qs = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [ Int -> Int -> Int
binom ((Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) | Int
k <- [Int
0..] ]
ixChomperRef :: Int -> Int -> (Int, Int)
ixChomperRef :: Int -> Int -> (Int, Int)
ixChomperRef Int
n Int
y = (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall a. [a] -> a
last [Int]
qs, [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
qs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
qs :: [Int]
qs = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [ Int -> Int -> Int
binom (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k) Int
n | Int
k <- [Int
0..] ]
vecRunIxPascal
:: Int
-> Int
-> Int
-> [Int]
vecRunIxPascal :: Int -> Int -> Int -> [Int]
vecRunIxPascal Int
n Int
mx Int
x = Int -> (Int, Int) -> [Int] -> [Int]
go Int
x (Int
mx,Int
n) []
where
go :: Int -> (Int, Int) -> [Int] -> [Int]
go :: Int -> (Int, Int) -> [Int] -> [Int]
go Int
q (!Int
m,!Int
k) [Int]
z = case Int -> (Int, Int) -> (Int, Int, (Int, Int))
chompPascal Int
q (Int
m,Int
k) of
(Int
j, Int
_, (Int
0 ,Int
k')) -> Int
k'Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
jInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
z
(Int
j, Int
r, (Int
m',Int
k')) -> Int -> (Int, Int) -> [Int] -> [Int]
go Int
r (Int
m',Int
k') (Int
jInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
z)
chompPascal :: Int -> (Int, Int) -> (Int, Int, (Int, Int))
chompPascal :: Int -> (Int, Int) -> (Int, Int, (Int, Int))
chompPascal = Int -> Int -> (Int, Int) -> (Int, Int, (Int, Int))
forall {t}. Num t => t -> Int -> (Int, Int) -> (t, Int, (Int, Int))
go Int
0
where
go :: t -> Int -> (Int, Int) -> (t, Int, (Int, Int))
go !t
i Int
q (!Int
n,!Int
k)
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (t
i, Int
q, (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
0))
| Bool
otherwise =
let x :: Int
x = Int -> Int -> Int
binom (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
in if Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
x then t -> Int -> (Int, Int) -> (t, Int, (Int, Int))
go (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1) (Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) (Int
n,Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
else (t
i, Int
q, (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
k))
genVecRunIxPascal
:: Int
-> Int
-> Int
-> [Int]
genVecRunIxPascal :: Int -> Int -> Int -> [Int]
genVecRunIxPascal Int
n Int
mx Int
x = Int -> (Int, Int) -> [Int]
go Int
x (Int
mx,Int
n)
where
go :: Int -> (Int, Int) -> [Int]
go :: Int -> (Int, Int) -> [Int]
go Int
q (!Int
m,!Int
k) = case Int -> (Int, Int) -> (Int, Int, (Int, Int))
chompPascal Int
q (Int
m,Int
k) of
(Int
j, Int
_, (Int
0, Int
k') ) -> [Int
j,Int
k']
(Int
j, Int
r, (Int
m',Int
k')) -> Int
j Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> (Int, Int) -> [Int]
go Int
r (Int
m',Int
k')
encRun :: Int -> [Int] -> [Int]
encRun :: Int -> [Int] -> [Int]
encRun Int
mx = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (Int
mx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0) ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [Int] -> [Int]
go Int
0 Int
0
where
go :: Int -> Int -> [Int] -> [Int]
go :: Int -> Int -> [Int] -> [Int]
go Int
x !Int
n = \case
[] -> [Int
n]
Int
y:[Int]
ys
| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y -> Int -> Int -> [Int] -> [Int]
go Int
x (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
ys
| Bool
otherwise -> Int
n Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Int] -> [Int]
go Int
y Int
1 [Int]
ys
neighbs2d :: Int -> Int -> [Int]
neighbs2d :: Int -> Int -> [Int]
neighbs2d Int
n Int
i =
[ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
dy
| Int
dx <- [Int
0,-Int
1,Int
1]
, Int
dy <- [Int
0,-Int
1,Int
1]
]
data NCount =
NOne
| NTwo
| NThree
| NMany
deriving (Int -> NCount -> ShowS
[NCount] -> ShowS
NCount -> String
(Int -> NCount -> ShowS)
-> (NCount -> String) -> ([NCount] -> ShowS) -> Show NCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NCount] -> ShowS
$cshowList :: [NCount] -> ShowS
show :: NCount -> String
$cshow :: NCount -> String
showsPrec :: Int -> NCount -> ShowS
$cshowsPrec :: Int -> NCount -> ShowS
Show, NCount -> NCount -> Bool
(NCount -> NCount -> Bool)
-> (NCount -> NCount -> Bool) -> Eq NCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NCount -> NCount -> Bool
$c/= :: NCount -> NCount -> Bool
== :: NCount -> NCount -> Bool
$c== :: NCount -> NCount -> Bool
Eq, Eq NCount
Eq NCount
-> (NCount -> NCount -> Ordering)
-> (NCount -> NCount -> Bool)
-> (NCount -> NCount -> Bool)
-> (NCount -> NCount -> Bool)
-> (NCount -> NCount -> Bool)
-> (NCount -> NCount -> NCount)
-> (NCount -> NCount -> NCount)
-> Ord NCount
NCount -> NCount -> Bool
NCount -> NCount -> Ordering
NCount -> NCount -> NCount
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NCount -> NCount -> NCount
$cmin :: NCount -> NCount -> NCount
max :: NCount -> NCount -> NCount
$cmax :: NCount -> NCount -> NCount
>= :: NCount -> NCount -> Bool
$c>= :: NCount -> NCount -> Bool
> :: NCount -> NCount -> Bool
$c> :: NCount -> NCount -> Bool
<= :: NCount -> NCount -> Bool
$c<= :: NCount -> NCount -> Bool
< :: NCount -> NCount -> Bool
$c< :: NCount -> NCount -> Bool
compare :: NCount -> NCount -> Ordering
$ccompare :: NCount -> NCount -> Ordering
Ord, (forall x. NCount -> Rep NCount x)
-> (forall x. Rep NCount x -> NCount) -> Generic NCount
forall x. Rep NCount x -> NCount
forall x. NCount -> Rep NCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NCount x -> NCount
$cfrom :: forall x. NCount -> Rep NCount x
Generic)
instance NFData NCount
instance Semigroup NCount where
NCount
NOne <> :: NCount -> NCount -> NCount
<> NCount
NOne = NCount
NTwo
NCount
NOne <> NCount
NTwo = NCount
NThree
NCount
NTwo <> NCount
NOne = NCount
NThree
NCount
_ <> NCount
_ = NCount
NMany
data LiveCount = Dead !Ordering
| LiveAlone
| Live !Ordering
| Overloaded
deriving (Int -> LiveCount -> ShowS
[LiveCount] -> ShowS
LiveCount -> String
(Int -> LiveCount -> ShowS)
-> (LiveCount -> String)
-> ([LiveCount] -> ShowS)
-> Show LiveCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiveCount] -> ShowS
$cshowList :: [LiveCount] -> ShowS
show :: LiveCount -> String
$cshow :: LiveCount -> String
showsPrec :: Int -> LiveCount -> ShowS
$cshowsPrec :: Int -> LiveCount -> ShowS
Show, LiveCount -> LiveCount -> Bool
(LiveCount -> LiveCount -> Bool)
-> (LiveCount -> LiveCount -> Bool) -> Eq LiveCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiveCount -> LiveCount -> Bool
$c/= :: LiveCount -> LiveCount -> Bool
== :: LiveCount -> LiveCount -> Bool
$c== :: LiveCount -> LiveCount -> Bool
Eq, Eq LiveCount
Eq LiveCount
-> (LiveCount -> LiveCount -> Ordering)
-> (LiveCount -> LiveCount -> Bool)
-> (LiveCount -> LiveCount -> Bool)
-> (LiveCount -> LiveCount -> Bool)
-> (LiveCount -> LiveCount -> Bool)
-> (LiveCount -> LiveCount -> LiveCount)
-> (LiveCount -> LiveCount -> LiveCount)
-> Ord LiveCount
LiveCount -> LiveCount -> Bool
LiveCount -> LiveCount -> Ordering
LiveCount -> LiveCount -> LiveCount
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LiveCount -> LiveCount -> LiveCount
$cmin :: LiveCount -> LiveCount -> LiveCount
max :: LiveCount -> LiveCount -> LiveCount
$cmax :: LiveCount -> LiveCount -> LiveCount
>= :: LiveCount -> LiveCount -> Bool
$c>= :: LiveCount -> LiveCount -> Bool
> :: LiveCount -> LiveCount -> Bool
$c> :: LiveCount -> LiveCount -> Bool
<= :: LiveCount -> LiveCount -> Bool
$c<= :: LiveCount -> LiveCount -> Bool
< :: LiveCount -> LiveCount -> Bool
$c< :: LiveCount -> LiveCount -> Bool
compare :: LiveCount -> LiveCount -> Ordering
$ccompare :: LiveCount -> LiveCount -> Ordering
Ord, (forall x. LiveCount -> Rep LiveCount x)
-> (forall x. Rep LiveCount x -> LiveCount) -> Generic LiveCount
forall x. Rep LiveCount x -> LiveCount
forall x. LiveCount -> Rep LiveCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiveCount x -> LiveCount
$cfrom :: forall x. LiveCount -> Rep LiveCount x
Generic)
instance NFData LiveCount
addOrdering :: a -> (Ordering -> a) -> Ordering -> Ordering -> a
addOrdering :: forall a. a -> (Ordering -> a) -> Ordering -> Ordering -> a
addOrdering a
x Ordering -> a
f = Ordering -> Ordering -> a
go
where
go :: Ordering -> Ordering -> a
go Ordering
LT Ordering
LT = Ordering -> a
f Ordering
EQ
go Ordering
LT Ordering
EQ = Ordering -> a
f Ordering
GT
go Ordering
EQ Ordering
LT = Ordering -> a
f Ordering
GT
go Ordering
_ Ordering
_ = a
x
toDead :: NCount -> LiveCount
toDead :: NCount -> LiveCount
toDead = \case
NCount
NOne -> Ordering -> LiveCount
Dead Ordering
LT
NCount
NTwo -> Ordering -> LiveCount
Dead Ordering
EQ
NCount
NThree -> Ordering -> LiveCount
Dead Ordering
GT
NCount
NMany -> LiveCount
Overloaded
instance Semigroup LiveCount where
Dead Ordering
n <> :: LiveCount -> LiveCount -> LiveCount
<> Dead Ordering
m = LiveCount
-> (Ordering -> LiveCount) -> Ordering -> Ordering -> LiveCount
forall a. a -> (Ordering -> a) -> Ordering -> Ordering -> a
addOrdering LiveCount
Overloaded Ordering -> LiveCount
Dead Ordering
n Ordering
m
Dead Ordering
n <> LiveCount
LiveAlone = Ordering -> LiveCount
Live Ordering
n
Dead Ordering
n <> Live Ordering
m = LiveCount
-> (Ordering -> LiveCount) -> Ordering -> Ordering -> LiveCount
forall a. a -> (Ordering -> a) -> Ordering -> Ordering -> a
addOrdering LiveCount
Overloaded Ordering -> LiveCount
Live Ordering
n Ordering
m
LiveCount
LiveAlone <> Dead Ordering
m = Ordering -> LiveCount
Live Ordering
m
LiveCount
LiveAlone <> LiveCount
LiveAlone = LiveCount
LiveAlone
LiveCount
LiveAlone <> Live Ordering
m = Ordering -> LiveCount
Live Ordering
m
Live Ordering
n <> Dead Ordering
m = LiveCount
-> (Ordering -> LiveCount) -> Ordering -> Ordering -> LiveCount
forall a. a -> (Ordering -> a) -> Ordering -> Ordering -> a
addOrdering LiveCount
Overloaded Ordering -> LiveCount
Live Ordering
n Ordering
m
Live Ordering
n <> LiveCount
LiveAlone = Ordering -> LiveCount
Live Ordering
n
Live Ordering
n <> Live Ordering
m = LiveCount
-> (Ordering -> LiveCount) -> Ordering -> Ordering -> LiveCount
forall a. a -> (Ordering -> a) -> Ordering -> Ordering -> a
addOrdering LiveCount
Overloaded Ordering -> LiveCount
Live Ordering
n Ordering
m
LiveCount
_ <> LiveCount
_ = LiveCount
Overloaded
validLiveCount :: LiveCount -> Bool
validLiveCount :: LiveCount -> Bool
validLiveCount = \case
Dead Ordering
GT -> Bool
True
Live Ordering
EQ -> Bool
True
Live Ordering
GT -> Bool
True
LiveCount
_ -> Bool
False
stepper
:: Int
-> (Int -> IntMap LiveCount)
-> IntMap IntSet
-> IntMap IntSet
stepper :: Int -> (Int -> IntMap LiveCount) -> IntMap IntSet -> IntMap IntSet
stepper Int
nxy Int -> IntMap LiveCount
syms IntMap IntSet
cs = (IntMap LiveCount -> IntSet)
-> IntMap (IntMap LiveCount) -> IntMap IntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IntMap LiveCount -> IntSet
forall a. IntMap a -> IntSet
IM.keysSet (IntMap LiveCount -> IntSet)
-> (IntMap LiveCount -> IntMap LiveCount)
-> IntMap LiveCount
-> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LiveCount -> Bool) -> IntMap LiveCount -> IntMap LiveCount
forall a. (a -> Bool) -> IntMap a -> IntMap a
IM.filter LiveCount -> Bool
validLiveCount) (IntMap (IntMap LiveCount) -> IntMap IntSet)
-> (MonoidalIntMap (MonoidalIntMap LiveCount)
-> IntMap (IntMap LiveCount))
-> MonoidalIntMap (MonoidalIntMap LiveCount)
-> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidalIntMap (MonoidalIntMap LiveCount)
-> IntMap (IntMap LiveCount)
coerce (MonoidalIntMap (MonoidalIntMap LiveCount) -> IntMap IntSet)
-> MonoidalIntMap (MonoidalIntMap LiveCount) -> IntMap IntSet
forall a b. (a -> b) -> a -> b
$
(((Int, IntSet) -> MonoidalIntMap (MonoidalIntMap LiveCount))
-> [(Int, IntSet)] -> MonoidalIntMap (MonoidalIntMap LiveCount))
-> [(Int, IntSet)]
-> ((Int, IntSet) -> MonoidalIntMap (MonoidalIntMap LiveCount))
-> MonoidalIntMap (MonoidalIntMap LiveCount)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int
-> ((Int, IntSet) -> MonoidalIntMap (MonoidalIntMap LiveCount))
-> [(Int, IntSet)]
-> MonoidalIntMap (MonoidalIntMap LiveCount)
forall a m. (NFData m, Monoid m) => Int -> (a -> m) -> [a] -> m
foldMapParChunk Int
chnk) (IntMap IntSet -> [(Int, IntSet)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap IntSet
cs) (((Int, IntSet) -> MonoidalIntMap (MonoidalIntMap LiveCount))
-> MonoidalIntMap (MonoidalIntMap LiveCount))
-> ((Int, IntSet) -> MonoidalIntMap (MonoidalIntMap LiveCount))
-> MonoidalIntMap (MonoidalIntMap LiveCount)
forall a b. (a -> b) -> a -> b
$ \(Int
gIx, IntSet
ds) ->
let T2 MonoidalIntMap LiveCount
updateHere MonoidalIntMap LiveCount
updateThere = Map
IntSet (T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
prebaked Map
IntSet (T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> IntSet
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount)
forall k a. Ord k => Map k a -> k -> a
M.! IntSet
ds
in IntMap (MonoidalIntMap LiveCount)
-> MonoidalIntMap (MonoidalIntMap LiveCount)
forall a. IntMap a -> MonoidalIntMap a
MIM.MonoidalIntMap (IntMap (MonoidalIntMap LiveCount)
-> MonoidalIntMap (MonoidalIntMap LiveCount))
-> ([(Int, MonoidalIntMap LiveCount)]
-> IntMap (MonoidalIntMap LiveCount))
-> [(Int, MonoidalIntMap LiveCount)]
-> MonoidalIntMap (MonoidalIntMap LiveCount)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, MonoidalIntMap LiveCount)]
-> IntMap (MonoidalIntMap LiveCount)
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, MonoidalIntMap LiveCount)]
-> MonoidalIntMap (MonoidalIntMap LiveCount))
-> [(Int, MonoidalIntMap LiveCount)]
-> MonoidalIntMap (MonoidalIntMap LiveCount)
forall a b. (a -> b) -> a -> b
$
[Int]
-> [MonoidalIntMap LiveCount] -> [(Int, MonoidalIntMap LiveCount)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> Int -> [Int]
neighbs2d Int
nxy Int
gIx) (MonoidalIntMap LiveCount
updateHere MonoidalIntMap LiveCount
-> [MonoidalIntMap LiveCount] -> [MonoidalIntMap LiveCount]
forall a. a -> [a] -> [a]
: MonoidalIntMap LiveCount -> [MonoidalIntMap LiveCount]
forall a. a -> [a]
repeat MonoidalIntMap LiveCount
updateThere)
where
uniqueGroups :: Set IntSet
uniqueGroups = [IntSet] -> Set IntSet
forall a. Ord a => [a] -> Set a
S.fromList ([IntSet] -> Set IntSet) -> [IntSet] -> Set IntSet
forall a b. (a -> b) -> a -> b
$ IntMap IntSet -> [IntSet]
forall a. IntMap a -> [a]
IM.elems IntMap IntSet
cs
prebaked :: Map IntSet (T2 (MIM.MonoidalIntMap LiveCount) (MIM.MonoidalIntMap LiveCount))
prebaked :: Map
IntSet (T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
prebaked = ((IntSet
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> Set IntSet
-> Map
IntSet (T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount)))
-> Set IntSet
-> (IntSet
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> Map
IntSet (T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (IntSet
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> Set IntSet
-> Map
IntSet (T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
forall k a. (k -> a) -> Set k -> Map k a
M.fromSet Set IntSet
uniqueGroups ((IntSet
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> Map
IntSet (T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount)))
-> (IntSet
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> Map
IntSet (T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
forall a b. (a -> b) -> a -> b
$ \IntSet
ds ->
((Int -> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> [Int]
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> [Int]
-> (Int
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> [Int]
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (IntSet -> [Int]
IS.toList IntSet
ds) ((Int -> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> (Int
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount))
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount)
forall a b. (a -> b) -> a -> b
$ \Int
pIx ->
let pNeighbs :: IntMap LiveCount
pNeighbs = Int -> IntMap LiveCount
syms Int
pIx
in MonoidalIntMap LiveCount
-> MonoidalIntMap LiveCount
-> T2 (MonoidalIntMap LiveCount) (MonoidalIntMap LiveCount)
forall a b. a -> b -> T2 a b
T2 (IntMap LiveCount -> MonoidalIntMap LiveCount
forall a. IntMap a -> MonoidalIntMap a
MIM.MonoidalIntMap (IntMap LiveCount -> MonoidalIntMap LiveCount)
-> IntMap LiveCount -> MonoidalIntMap LiveCount
forall a b. (a -> b) -> a -> b
$ (LiveCount -> LiveCount -> LiveCount)
-> Int -> LiveCount -> IntMap LiveCount -> IntMap LiveCount
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith LiveCount -> LiveCount -> LiveCount
forall a. Semigroup a => a -> a -> a
(<>) Int
pIx LiveCount
LiveAlone IntMap LiveCount
pNeighbs)
(IntMap LiveCount -> MonoidalIntMap LiveCount
forall a. IntMap a -> MonoidalIntMap a
MIM.MonoidalIntMap (IntMap LiveCount -> MonoidalIntMap LiveCount)
-> IntMap LiveCount -> MonoidalIntMap LiveCount
forall a b. (a -> b) -> a -> b
$ (LiveCount -> LiveCount -> LiveCount)
-> Int -> LiveCount -> IntMap LiveCount -> IntMap LiveCount
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith LiveCount -> LiveCount -> LiveCount
forall a. Semigroup a => a -> a -> a
(<>) Int
pIx (Ordering -> LiveCount
Dead Ordering
LT) IntMap LiveCount
pNeighbs)
chnk :: Int
chnk = Int
100 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
5 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` (IntMap IntSet -> Int
forall a. IntMap a -> Int
IM.size IntMap IntSet
cs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10)
neighbs :: (Num a, Eq a) => a -> [a] -> [[a]]
neighbs :: forall a. (Num a, Eq a) => a -> [a] -> [[a]]
neighbs a
mx = [[a]] -> [[a]]
forall a. [a] -> [a]
tail ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a]) -> [a] -> [[a]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\a
x -> if | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
mx -> [a
x,a
xa -> a -> a
forall a. Num a => a -> a -> a
-a
1]
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 -> [a
x,a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
1,a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
1]
| Bool
otherwise -> [a
x,a
xa -> a -> a
forall a. Num a => a -> a -> a
-a
1,a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
1]
)
{-# INLINE neighbs #-}
oldNeighborWeights
:: Int
-> Int
-> V.Vector (IntMap NCount)
oldNeighborWeights :: Int -> Int -> Vector (IntMap NCount)
oldNeighborWeights Int
d Int
mx = (forall s. ST s (Vector (IntMap NCount))) -> Vector (IntMap NCount)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector (IntMap NCount)))
-> Vector (IntMap NCount))
-> (forall s. ST s (Vector (IntMap NCount)))
-> Vector (IntMap NCount)
forall a b. (a -> b) -> a -> b
$ do
MVector s (IntMap NCount)
v <- Int
-> IntMap NCount
-> ST s (MVector (PrimState (ST s)) (IntMap NCount))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
MV.replicate Int
n' IntMap NCount
forall a. IntMap a
IM.empty
[Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
x ->
[[Int]] -> ([Int] -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Int -> [Int] -> [[Int]]
forall a. (Num a, Eq a) => a -> [a] -> [[a]]
neighbs (Int
mxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> Int -> [Int]
ixPascal Int
d Int
x)) (([Int] -> ST s ()) -> ST s ()) -> ([Int] -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \[Int]
i -> do
let pIx :: Int
pIx = [Int] -> Int
pascalIx ([Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
i)
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
pIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n') (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
MVector (PrimState (ST s)) (IntMap NCount)
-> (IntMap NCount -> IntMap NCount) -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> (a -> a) -> Int -> m ()
MV.modify MVector s (IntMap NCount)
MVector (PrimState (ST s)) (IntMap NCount)
v ((NCount -> NCount -> NCount)
-> Int -> NCount -> IntMap NCount -> IntMap NCount
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith ((NCount -> NCount -> NCount) -> NCount -> NCount -> NCount
forall a b c. (a -> b -> c) -> b -> a -> c
flip NCount -> NCount -> NCount
forall a. Semigroup a => a -> a -> a
(<>)) Int
x NCount
NOne) Int
pIx
MVector (PrimState (ST s)) (IntMap NCount)
-> ST s (Vector (IntMap NCount))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector s (IntMap NCount)
MVector (PrimState (ST s)) (IntMap NCount)
v
where
n :: Int
n = Int -> Int -> Int
binom (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
mx) Int
mx
n' :: Int
n' = Int -> Int -> Int
binom (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
mxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
mxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
finalWeight
:: (Num a, Ord a)
=> Int
-> [a]
-> Integer
finalWeight :: forall a. (Num a, Ord a) => Int -> [a] -> Integer
finalWeight Int
n [a]
x = Map a Int -> Integer
process (Map a Int -> Integer) -> ([a] -> Map a Int) -> [a] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Map a Int
forall (f :: * -> *) a. (Foldable f, Ord a) => f a -> Map a Int
freqs ([a] -> Integer) -> [a] -> Integer
forall a b. (a -> b) -> a -> b
$ [a]
x
where
process :: Map a Int -> Integer
process Map a Int
mp = (Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
numNonZeroes) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
perms
where
numNonZeroes :: Int
numNonZeroes = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Map a Int -> Int
forall a. Ord a => a -> Map a Int -> Int
lookupFreq a
0 Map a Int
mp
perms :: Integer
perms = Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Map a Integer -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (Integer -> Integer
integerFactorial (Integer -> Integer) -> (Int -> Integer) -> Int -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Map a Int -> Map a Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map a Int
mp)
vecRunNeighbs_
:: VU.Vector Int
-> [(VU.Vector Int, NCount)]
vecRunNeighbs_ :: Vector Int -> [(Vector Int, NCount)]
vecRunNeighbs_ Vector Int
xs0 = ((Vector Int, T3 (Vector Int) Bool Int)
-> Maybe (Vector Int, NCount))
-> [(Vector Int, T3 (Vector Int) Bool Int)]
-> [(Vector Int, NCount)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Vector Int, T3 (Vector Int) Bool Int)
-> Maybe (Vector Int, NCount)
forall {a} {a} {a}.
(Num a, Eq a) =>
(a, T3 a Bool a) -> Maybe (a, NCount)
pullSame ([(Vector Int, T3 (Vector Int) Bool Int)]
-> [(Vector Int, NCount)])
-> [(Vector Int, T3 (Vector Int) Bool Int)]
-> [(Vector Int, NCount)]
forall a b. (a -> b) -> a -> b
$
StateT (T3 (Vector Int) Bool Int) [] (Vector Int)
-> T3 (Vector Int) Bool Int
-> [(Vector Int, T3 (Vector Int) Bool Int)]
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Backwards (StateT (T3 (Vector Int) Bool Int) []) (Vector Int)
-> StateT (T3 (Vector Int) Bool Int) [] (Vector Int)
forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards (Backwards (StateT (T3 (Vector Int) Bool Int) []) (Vector Int)
-> StateT (T3 (Vector Int) Bool Int) [] (Vector Int))
-> Backwards (StateT (T3 (Vector Int) Bool Int) []) (Vector Int)
-> StateT (T3 (Vector Int) Bool Int) [] (Vector Int)
forall a b. (a -> b) -> a -> b
$ (Indexed
Int Int (Backwards (StateT (T3 (Vector Int) Bool Int) []) Int)
-> Vector Int
-> Backwards (StateT (T3 (Vector Int) Bool Int) []) (Vector Int))
-> (Int
-> Int -> Backwards (StateT (T3 (Vector Int) Bool Int) []) Int)
-> Vector Int
-> Backwards (StateT (T3 (Vector Int) Bool Int) []) (Vector Int)
forall i a (f :: * -> *) b s t.
(Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
itraverseOf Indexed
Int Int (Backwards (StateT (T3 (Vector Int) Bool Int) []) Int)
-> Vector Int
-> Backwards (StateT (T3 (Vector Int) Bool Int) []) (Vector Int)
forall (v :: * -> *) a (w :: * -> *) b.
(Vector v a, Vector w b) =>
IndexedTraversal Int (v a) (w b) a b
V.vectorTraverse Int -> Int -> Backwards (StateT (T3 (Vector Int) Bool Int) []) Int
go Vector Int
xs0) (Vector Int -> Bool -> Int -> T3 (Vector Int) Bool Int
forall a b c. a -> b -> c -> T3 a b c
T3 Vector Int
xs0 Bool
True Int
1)
where
pullSame :: (a, T3 a Bool a) -> Maybe (a, NCount)
pullSame (a
_, T3 a
_ Bool
True a
_) = Maybe (a, NCount)
forall a. Maybe a
Nothing
pullSame (a
x, T3 a
_ Bool
_ a
p) = (a, NCount) -> Maybe (a, NCount)
forall a. a -> Maybe a
Just (a
x, a -> NCount
forall a. (Num a, Eq a) => a -> NCount
toNCount a
p)
go :: Int -> Int -> Backwards (StateT (T3 (VU.Vector Int) Bool Int) []) Int
go :: Int -> Int -> Backwards (StateT (T3 (Vector Int) Bool Int) []) Int
go Int
i Int
x0 = StateT (T3 (Vector Int) Bool Int) [] Int
-> Backwards (StateT (T3 (Vector Int) Bool Int) []) Int
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (StateT (T3 (Vector Int) Bool Int) [] Int
-> Backwards (StateT (T3 (Vector Int) Bool Int) []) Int)
-> StateT (T3 (Vector Int) Bool Int) [] Int
-> Backwards (StateT (T3 (Vector Int) Bool Int) []) Int
forall a b. (a -> b) -> a -> b
$ (T3 (Vector Int) Bool Int -> [(Int, T3 (Vector Int) Bool Int)])
-> StateT (T3 (Vector Int) Bool Int) [] Int
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((T3 (Vector Int) Bool Int -> [(Int, T3 (Vector Int) Bool Int)])
-> StateT (T3 (Vector Int) Bool Int) [] Int)
-> (T3 (Vector Int) Bool Int -> [(Int, T3 (Vector Int) Bool Int)])
-> StateT (T3 (Vector Int) Bool Int) [] Int
forall a b. (a -> b) -> a -> b
$ \(T3 Vector Int
xs Bool
allSame Int
p) -> do
let l0 :: Maybe Int
l0 = Vector Int
xs Vector Int -> Int -> Maybe Int
forall a. Unbox a => Vector a -> Int -> Maybe a
VU.!? (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
x :: Int
x = Vector Int
xs Vector Int -> Int -> Int
forall a. Unbox a => Vector a -> Int -> a
VU.! Int
i
r :: Int
r = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Vector Int
xs Vector Int -> Int -> Maybe Int
forall a. Unbox a => Vector a -> Int -> Maybe a
VU.!? (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
case Maybe Int
l0 of
Maybe Int
Nothing -> (Int, T3 (Vector Int) Bool Int)
-> [(Int, T3 (Vector Int) Bool Int)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
let res :: Int
res = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
p' :: Int
p' = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
factorial Int
res Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
r) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
factorial Int
x
in (Int
res, Vector Int -> Bool -> Int -> T3 (Vector Int) Bool Int
forall a b c. a -> b -> c -> T3 a b c
T3 Vector Int
xs (Bool
allSame Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x0) Int
p')
Just Int
l -> do
Int
xlContrib <- [Int
0..(Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l)]
Int
lContrib <- [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
xlContribInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l Int
xlContrib]
let xContrib :: Int
xContrib = Int
xlContrib Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lContrib
res :: Int
res = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xlContrib
xs' :: Vector Int
xs' = Vector Int
xs Vector Int -> [(Int, Int)] -> Vector Int
forall a. Unbox a => Vector a -> [(Int, a)] -> Vector a
VU.// [(Int
i, Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
xContrib), (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lContrib)]
p' :: Int
p' = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
factorial Int
res
Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
factorial Int
r
Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
factorial Int
xContrib
Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
factorial Int
lContrib
(Int, T3 (Vector Int) Bool Int)
-> [(Int, T3 (Vector Int) Bool Int)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
res, Vector Int -> Bool -> Int -> T3 (Vector Int) Bool Int
forall a b c. a -> b -> c -> T3 a b c
T3 Vector Int
xs' (Bool
allSame Bool -> Bool -> Bool
&& Int
xContrib Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x0) Int
p')
vecRunNeighbs
:: Int
-> Int
-> Int
-> [(Int, NCount)]
vecRunNeighbs :: Int -> Int -> Int -> [(Int, NCount)]
vecRunNeighbs Int
n Int
mx = (\(Int
x:[Int]
xs) -> (Int, Int)
-> Int
-> Int
-> Bool
-> NCount
-> Int
-> Int
-> [Int]
-> [(Int, NCount)]
go (Int
mx,Int
n) Int
0 Int
x Bool
True NCount
NOne Int
0 Int
x [Int]
xs)
([Int] -> [(Int, NCount)])
-> (Int -> [Int]) -> Int -> [(Int, NCount)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int -> [Int]
genVecRunIxPascal Int
n Int
mx
where
go :: (Int, Int)
-> Int
-> Int
-> Bool
-> NCount
-> Int
-> Int
-> [Int]
-> [(Int, NCount)]
go :: (Int, Int)
-> Int
-> Int
-> Bool
-> NCount
-> Int
-> Int
-> [Int]
-> [(Int, NCount)]
go (!Int
i,!Int
j) !Int
tot Int
x0 Bool
allSame !NCount
p Int
r Int
x = \case
[] ->
let res :: Int
res = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
p' :: NCount
p' = NCount
p NCount -> NCount -> NCount
`mulNCount` forall a. (Num a, Eq a) => a -> NCount
toNCount @Integer
( Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
res)
Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
r)
Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r)
)
tot' :: Int
tot' = Int
tot
in (Int
tot', NCount
p') (Int, NCount) -> [()] -> [(Int, NCount)]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool
allSame Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x0))
Int
l:[Int]
ls -> do
Int
xlContrib <- [Int
0..(Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l)]
Int
lContrib <- [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
xlContribInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l Int
xlContrib]
let xContrib :: Int
xContrib = Int
xlContrib Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lContrib
res :: Int
res = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xlContrib
l' :: Int
l' = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lContrib
x' :: Int
x' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xContrib
p' :: NCount
p' = NCount
p NCount -> NCount -> NCount
`mulNCount` forall a. (Num a, Eq a) => a -> NCount
toNCount @Integer
( Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
res)
Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r)
Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
xContrib)
Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lContrib)
)
tot' :: Int
tot' = Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Int -> Int -> Int
binom (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) | Int
k <- [Int
1..Int
res] ]
i' :: Int
i' = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
j' :: Int
j' = Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
res
(Int, Int)
-> Int
-> Int
-> Bool
-> NCount
-> Int
-> Int
-> [Int]
-> [(Int, NCount)]
go (Int
i',Int
j') Int
tot' Int
l (Bool
allSame Bool -> Bool -> Bool
&& Int
xContrib Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x0) NCount
p' Int
x' Int
l' [Int]
ls
vecRunNeighbsInt
:: Int
-> Int
-> Int
-> [(Int, Integer)]
vecRunNeighbsInt :: Int -> Int -> Int -> [(Int, Integer)]
vecRunNeighbsInt Int
n Int
mx = (\(Int
x:[Int]
xs) -> (Int, Int)
-> Int
-> Int
-> Bool
-> Integer
-> Int
-> Int
-> [Int]
-> [(Int, Integer)]
go (Int
mx,Int
n) Int
0 Int
x Bool
True Integer
1 Int
0 Int
x [Int]
xs)
([Int] -> [(Int, Integer)])
-> (Int -> [Int]) -> Int -> [(Int, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int -> [Int]
genVecRunIxPascal Int
n Int
mx
where
go :: (Int, Int)
-> Int
-> Int
-> Bool
-> Integer
-> Int
-> Int
-> [Int]
-> [(Int, Integer)]
go :: (Int, Int)
-> Int
-> Int
-> Bool
-> Integer
-> Int
-> Int
-> [Int]
-> [(Int, Integer)]
go (!Int
i,!Int
j) !Int
tot Int
x0 Bool
allSame !Integer
p Int
r Int
x = \case
[] ->
let res :: Int
res = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
p' :: Integer
p' = Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*
( Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
res)
Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
r)
Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r)
)
tot' :: Int
tot' = Int
tot
in (Int
tot', Integer
p') (Int, Integer) -> [()] -> [(Int, Integer)]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool
allSame Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x0))
Int
l:[Int]
ls -> do
Int
xlContrib <- [Int
0..(Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l)]
Int
lContrib <- [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
xlContribInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l Int
xlContrib]
let xContrib :: Int
xContrib = Int
xlContrib Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lContrib
res :: Int
res = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xlContrib
l' :: Int
l' = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lContrib
x' :: Int
x' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xContrib
p' :: Integer
p' = Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*
( Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
res)
Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r)
Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
xContrib)
Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer -> Integer
integerFactorial (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lContrib)
)
tot' :: Int
tot' = Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Int -> Int -> Int
binom (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) | Int
k <- [Int
1..Int
res] ]
i' :: Int
i' = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
j' :: Int
j' = Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
res
(Int, Int)
-> Int
-> Int
-> Bool
-> Integer
-> Int
-> Int
-> [Int]
-> [(Int, Integer)]
go (Int
i',Int
j') Int
tot' Int
l (Bool
allSame Bool -> Bool -> Bool
&& Int
xContrib Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x0) Integer
p' Int
x' Int
l' [Int]
ls
neighborWeights
:: Int
-> Int
-> V.Vector (IntMap NCount)
neighborWeights :: Int -> Int -> Vector (IntMap NCount)
neighborWeights Int
d Int
mx =
[IntMap NCount] -> Vector (IntMap NCount)
forall a. [a] -> Vector a
V.fromList
([IntMap NCount] -> Vector (IntMap NCount))
-> ([Int] -> [IntMap NCount]) -> [Int] -> Vector (IntMap NCount)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IntMap NCount) -> [Int] -> [IntMap NCount]
forall a b. (a -> b) -> [a] -> [b]
map ((NCount -> NCount -> NCount) -> [(Int, NCount)] -> IntMap NCount
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith NCount -> NCount -> NCount
forall a. Semigroup a => a -> a -> a
(<>) ([(Int, NCount)] -> IntMap NCount)
-> (Int -> [(Int, NCount)]) -> Int -> IntMap NCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int -> [(Int, NCount)]
vecRunNeighbs Int
d Int
mx)
([Int] -> Vector (IntMap NCount))
-> [Int] -> Vector (IntMap NCount)
forall a b. (a -> b) -> a -> b
$ [Int
0 .. Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
where
n' :: Int
n' = Int -> Int -> Int
binom (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
mxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
mxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
toNCount :: (Num a, Eq a) => a -> NCount
toNCount :: forall a. (Num a, Eq a) => a -> NCount
toNCount = \case
a
1 -> NCount
NOne
a
2 -> NCount
NTwo
a
3 -> NCount
NThree
a
_ -> NCount
NMany
mulNCount :: NCount -> NCount -> NCount
mulNCount :: NCount -> NCount -> NCount
mulNCount NCount
NOne NCount
y = NCount
y
mulNCount NCount
x NCount
NOne = NCount
x
mulNCount NCount
_ NCount
_ = NCount
NMany
runDay17
:: Bool
-> Bool
-> Int
-> Int
-> Set Point
-> [IntMap IntSet]
runDay17 :: Bool -> Bool -> Int -> Int -> Set (V2 Int) -> [IntMap IntSet]
runDay17 Bool
cache Bool
vcache Int
mx Int
d (Set (V2 Int) -> [V2 Int]
forall a. Set a -> [a]
S.toList -> [V2 Int]
x) =
Int -> [IntMap IntSet] -> [IntMap IntSet]
forall a. Int -> [a] -> [a]
take (Int
mx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
([IntMap IntSet] -> [IntMap IntSet])
-> (IntMap IntSet -> [IntMap IntSet])
-> IntMap IntSet
-> [IntMap IntSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap IntSet -> IntMap IntSet)
-> IntMap IntSet -> [IntMap IntSet]
forall a. (a -> a) -> a -> [a]
strictIterate (IntMap IntSet -> IntMap IntSet
forall a. NFData a => a -> a
force (IntMap IntSet -> IntMap IntSet)
-> (IntMap IntSet -> IntMap IntSet)
-> IntMap IntSet
-> IntMap IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int -> IntMap LiveCount) -> IntMap IntSet -> IntMap IntSet
stepper Int
nxy Int -> IntMap LiveCount
wts)
(IntMap IntSet -> [IntMap IntSet])
-> IntMap IntSet -> [IntMap IntSet]
forall a b. (a -> b) -> a -> b
$ IntMap IntSet
shifted
where
bounds :: Int
bounds = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((V2 Int -> [Int]) -> [V2 Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap V2 Int -> [Int]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [V2 Int]
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
nxy :: Int
nxy = Int
bounds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mxInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2
shifted :: IntMap IntSet
shifted = [(Int, IntSet)] -> IntMap IntSet
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, IntSet)] -> IntMap IntSet)
-> [(Int, IntSet)] -> IntMap IntSet
forall a b. (a -> b) -> a -> b
$
(\(V2 Int
i Int
j) -> (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nxy, Int -> IntSet
IS.singleton Int
0)) (V2 Int -> (Int, IntSet))
-> (V2 Int -> V2 Int) -> V2 Int -> (Int, IntSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V2 Int -> V2 Int -> V2 Int
forall a. Num a => a -> a -> a
+ Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 Int
mx Int
mx) (V2 Int -> (Int, IntSet)) -> [V2 Int] -> [(Int, IntSet)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [V2 Int]
x
mx' :: Int
mx'
| Bool
cache = Int
mx
| Bool
otherwise = Int
mx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [V2 Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [V2 Int]
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- [V2 Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [V2 Int]
x
{-# INLINE mx' #-}
wts :: Int -> IntMap LiveCount
wts
| Bool
vcache = (((NCount -> LiveCount) -> IntMap NCount -> IntMap LiveCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NCount -> LiveCount
toDead (IntMap NCount -> IntMap LiveCount)
-> Vector (IntMap NCount) -> Vector (IntMap LiveCount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Vector (IntMap NCount)
neighborWeights Int
d Int
mx') Vector (IntMap LiveCount) -> Int -> IntMap LiveCount
forall a. Vector a -> Int -> a
V.!)
| Bool
otherwise = (Int -> IntMap LiveCount) -> Int -> IntMap LiveCount
forall a. Integral a => Memo a
Memo.integral ((Int -> IntMap LiveCount) -> Int -> IntMap LiveCount)
-> (Int -> IntMap LiveCount) -> Int -> IntMap LiveCount
forall a b. (a -> b) -> a -> b
$ (LiveCount -> LiveCount -> LiveCount)
-> [(Int, LiveCount)] -> IntMap LiveCount
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith LiveCount -> LiveCount -> LiveCount
forall a. Semigroup a => a -> a -> a
(<>)
([(Int, LiveCount)] -> IntMap LiveCount)
-> (Int -> [(Int, LiveCount)]) -> Int -> IntMap LiveCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, NCount) -> (Int, LiveCount))
-> [(Int, NCount)] -> [(Int, LiveCount)]
forall a b. (a -> b) -> [a] -> [b]
map ((NCount -> LiveCount) -> (Int, NCount) -> (Int, LiveCount)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second NCount -> LiveCount
toDead)
([(Int, NCount)] -> [(Int, LiveCount)])
-> (Int -> [(Int, NCount)]) -> Int -> [(Int, LiveCount)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int -> [(Int, NCount)]
vecRunNeighbs Int
d Int
mx'
{-# INLINE runDay17 #-}
day17
:: Int
-> Set Point :~> Integer
day17 :: Int -> Set (V2 Int) :~> Integer
day17 Int
d = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
{ sParse :: String -> Maybe (Set (V2 Int))
sParse = Set (V2 Int) -> Maybe (Set (V2 Int))
forall a. a -> Maybe a
Just (Set (V2 Int) -> Maybe (Set (V2 Int)))
-> (String -> Set (V2 Int)) -> String -> Maybe (Set (V2 Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Set (V2 Int)
parseAsciiSet (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#')
, sShow :: Integer -> String
sShow = Integer -> String
forall a. Show a => a -> String
show
, sSolve :: (?dyno::DynoMap) => Set (V2 Int) -> Maybe Integer
sSolve = (IntMap IntSet -> Integer)
-> Maybe (IntMap IntSet) -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer)
-> (IntMap IntSet -> [Integer]) -> IntMap IntSet -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntSet -> Integer) -> [IntSet] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ([Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer)
-> (IntSet -> [Integer]) -> IntSet -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Int] -> Integer
forall a. (Num a, Ord a) => Int -> [a] -> Integer
finalWeight Int
d ([Int] -> Integer) -> (Int -> [Int]) -> Int -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [Int]
ixPascal Int
d) ([Int] -> [Integer]) -> (IntSet -> [Int]) -> IntSet -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.toList) ([IntSet] -> [Integer])
-> (IntMap IntSet -> [IntSet]) -> IntMap IntSet -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap IntSet -> [IntSet]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
(Maybe (IntMap IntSet) -> Maybe Integer)
-> (Set (V2 Int) -> Maybe (IntMap IntSet))
-> Set (V2 Int)
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IntMap IntSet] -> Maybe (IntMap IntSet)
forall a. [a] -> Maybe a
lastMay
([IntMap IntSet] -> Maybe (IntMap IntSet))
-> (Set (V2 Int) -> [IntMap IntSet])
-> Set (V2 Int)
-> Maybe (IntMap IntSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool -> Int -> Int -> Set (V2 Int) -> [IntMap IntSet]
runDay17 Bool
False Bool
False Int
6 Int
d
}
{-# INLINE day17 #-}
day17a :: Set Point :~> Integer
day17a :: Set (V2 Int) :~> Integer
day17a = Int -> Set (V2 Int) :~> Integer
day17 Int
1
day17b :: Set Point :~> Integer
day17b :: Set (V2 Int) :~> Integer
day17b = Int -> Set (V2 Int) :~> Integer
day17 Int
2