-- |
-- Module      : AOC.Challenge.Day17
-- License     : BSD3
--
-- Stability   : experimental
-- Portability : non-portable

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      -- ^ dimension
    -> 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)     -- (y - last qs), length qs - 1
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      -- ^ dimension
    -> 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)     -- last qs, length qs - 1
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      -- ^ dimension
    -> Int      -- ^ maximum
    -> Int      -- ^ number
    -> [Int]    -- ^ run
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      -- ^ dimension
    -> Int      -- ^ maximum
    -> Int      -- ^ number
    -> [Int]    -- ^ runs, but reverse order
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                          -- ^ how big the xy plane is
    -> (Int -> IntMap LiveCount)    -- ^ neighbor getter function (please cache)
    -> IntMap IntSet                -- ^ alive set: map of <x.y> to all zw+ points (pascal coords)
    -> 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
    -- the number of unique groups stays constant as you increase d
    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            -- ^ dimension
    -> Int            -- ^ maximum
    -> 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)

-- -- used to test finalWeights
-- _duplicands
--     :: (Ord a, Num a, Enum a)
--     => a      -- ^ maximum
--     -> Int    -- ^ length (dimension)
--     -> Map [a] Int
-- _duplicands mx n = freqs . map symmer $ replicateM n [-mx .. mx]
--   where
--     symmer    = sort . map abs

finalWeight
    :: (Num a, Ord a)
    => Int              -- ^ dim
    -> [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)


-- | Reference implementation for 'vecRunNeighbs', which takes and returns
-- actual vec run neighbors
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)
    -- we go backwards because it makes the final choice (1->0 transitions)
    -- simpler
    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')

-- | Streaming/constant space enumerate all neighbor and multiplicities
vecRunNeighbs
    :: Int      -- ^ dimension
    -> Int      -- ^ maximum
    -> 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
    -- we build these in reverse because we can both generate and encode
    -- pascal indices in reverse order in constant space/a streaming way
    -- and also because it makes the final choice for 1->0 transitions much
    -- simpler
    go  :: (Int, Int)   -- ^ running pascal triangle index
        -> Int          -- ^ running total
        -> Int          -- ^ original item in that position
        -> Bool         -- ^ currently all the same?
        -> NCount       -- ^ multiplicity
        -> Int          -- ^ item to the right
        -> Int          -- ^ current item
        -> [Int]        -- ^ leftover items (right to left)
        -> [(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

-- | Streaming/constant space enumerate all neighbor and multiplicities
vecRunNeighbsInt
    :: Int      -- ^ dimension
    -> Int      -- ^ maximum
    -> 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
    -- we build these in reverse because we can both generate and encode
    -- pascal indices in reverse order in constant space/a streaming way
    -- and also because it makes the final choice for 1->0 transitions much
    -- simpler
    go  :: (Int, Int)   -- ^ running pascal triangle index
        -> Int          -- ^ running total
        -> Int          -- ^ original item in that position
        -> Bool         -- ^ currently all the same?
        -> Integer      -- ^ multiplicity
        -> Int          -- ^ item to the right
        -> Int          -- ^ current item
        -> [Int]        -- ^ leftover items (right to left)
        -> [(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


-- | Build up all the weights for quick reference comparison
neighborWeights
    :: Int            -- ^ dimension
    -> Int            -- ^ maximum
    -> 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
    -- 0 -> error "0 ncount"
    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               -- ^ cache neighbors between runs
    -> Bool               -- ^ use an up-front vector cache (instead of dynamic memotable)
    -> Int                -- ^ number of steps
    -> Int                -- ^ dimensions
    -> Set Point          -- ^ points
    -> [IntMap IntSet]    -- ^ steps
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

-- d=5: 5760 / 16736; 274ms     -- with unboxed, 96ms, with pre-neighb: 35ms
-- d=6: 35936 / 95584; 1.5s     -- with unboxed, 309ms, with pre-neighb: 105ms
-- d=7: 178720 / 502240; 7.7s   -- with pre-neighbs: 356ms (no cache: 290ms)
-- d=8: 900288 / 2567360; 30s        -- with pre-neighbs: 1.2s (no cache: 690ms) (smallcache: 920ms)
-- d=9: 4333056 / 12764416; 2m20s   -- with pre-neighbs: 4.8s (no cache: 1.5s)
--                                                  no knownnat: 4.3s
-- d=10: 20251648 / 62771200; 8m58s    -- with unboxed, 1m6s, with pre-neighb: 21s (no cache: 2.56?)
--                                      no knownnat: 19s
--                                      smallcache: 12s
--                                      smart cache: 4.0s total
--                                      no-t=6 cache: 3.3s total
--                                      smarter t=6 cache: 3.0s total
--                                      unflatted step grid: 2.1s total
--                                      pure grid: 1.2s total
--                                      unique z-stacks: 120ms step
-- d=11: 93113856 / 309176832; 43m54s  -- with unboxed, 5m3s, with pre-neighb: 1m43s (no cache: 4.5s)
--                                      smallcache: 52s
--                                      8.8s v 7.7s
--                                      smarter t=6 cache: 5.8s
--                                      unique z-stacks: 172ms step
-- d=12: 424842240 / 1537981440 -- with unboxed, 22m10s, with pre-neighb: 8m30s (no cache: 7.4s)
--                                      smart cache: 21.5s total
--                                      21s vs 17s
--                                      no t=6 cache: 14s
--                                      unique z-stacks: 281ms step
-- d=13: 1932496896 / 7766482944 -- sqlite3 cache: 13.4s
--                                      smart cache: 1m10s total
--                                      new: 43s
--                                      unique z-stacks: 421ms step
-- d=14: 8778178560 / 39942504448 -- sqlite3 cache: 21.6s
--                                      new: 2m21s total
--                                      unique z-stacks: 647ms step
--                                      forward cache: (old) 4.8s all in memory
--                                          -> 1.2s with streaming neighbor gen
-- d=15: 39814275072 / 209681145856 -- sqlite3 cache: 32.5s, (including loading: 1m20s); smart cache: 4h35m
--    new method: total cache + run = 20m53s
--                                      unique z-stacks: 1.00s step
-- d=16: ? / 1125317394432 -- build sqlite cache + run = 62m44; run = 2m25s
--                                      unique z-stacks: 1.37s step
-- d=17: ? / 6178939535360 -- build sqlite cache + run = 24m
--                                      unique z-stacks: 2.08s step
-- d=18: ? / 34702568194048 -- build sqlite cache + run = 75m
--                                      unique z-stacks: 3.19s step
-- d=19: ? / 199077056872448 -- build sqlite cache + run = 220m
--                                      unique z-stacks: 18s step step
--                                      forward neighb: 11.4s
-- d=20: ? / 1163817241018368 -- forward neighb: 16.6s
--                                      forward cache: 6.4s
-- d=21: ? / 6913315519332352 -- forward neighb: 23.3s
--                                      forward cache: 9.2s
-- d=22: ? / 41598514437816320 -- forward neighb: 34.0s
--                                      forward cache: 12.8s
-- d=30: ? / 86683143717026864824320 -- forward neighb: 5m1s