{-#LANGUAGE DeriveDataTypeable#-}

module Control.Enumerable.Count (
  Count(..),
  (!!*),
  (</>),
  module Control.Enumerable
  ) where

import Control.Enumerable
import Control.Sized
import Data.Semigroup
import Data.Monoid(Monoid(..))
import Data.List
import Data.Typeable(Typeable)

-- | Counts the number of values of a all sizes. Usage: @global :: Count [Bool]
newtype Count a = Count {Count a -> [Integer]
count :: [Integer]} deriving (Typeable, Int -> Count a -> ShowS
[Count a] -> ShowS
Count a -> String
(Int -> Count a -> ShowS)
-> (Count a -> String) -> ([Count a] -> ShowS) -> Show (Count a)
forall a. Int -> Count a -> ShowS
forall a. [Count a] -> ShowS
forall a. Count a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Count a] -> ShowS
$cshowList :: forall a. [Count a] -> ShowS
show :: Count a -> String
$cshow :: forall a. Count a -> String
showsPrec :: Int -> Count a -> ShowS
$cshowsPrec :: forall a. Int -> Count a -> ShowS
Show)


-- Switch phantom type
untyped :: Count a -> Count b
untyped :: Count a -> Count b
untyped (Count [Integer]
x) = [Integer] -> Count b
forall a. [Integer] -> Count a
Count [Integer]
x

-- countparam :: Enumerable a => f a -> Count a
-- countparam _ = global

compact :: Count a -> Count a
compact :: Count a -> Count a
compact = [Integer] -> Count a
forall a. [Integer] -> Count a
Count ([Integer] -> Count a)
-> (Count a -> [Integer]) -> Count a -> Count a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Integer]
forall a. [a] -> [a]
reverse ([Integer] -> [Integer])
-> (Count a -> [Integer]) -> Count a -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
0) ([Integer] -> [Integer])
-> (Count a -> [Integer]) -> Count a -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Integer]
forall a. [a] -> [a]
reverse ([Integer] -> [Integer])
-> (Count a -> [Integer]) -> Count a -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Count a -> [Integer]
forall a. Count a -> [Integer]
count

-- | Counts the number of values of a given size, 0 if out of bounds.
(!!*) :: Count a -> Int -> Integer
(Count []) !!* :: Count a -> Int -> Integer
!!* Int
n = Integer
0
(Count (Integer
x:[Integer]
xs)) !!* Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0  = Integer
0
                        | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Integer
x -- TODO: Check only once
                        | Bool
otherwise = [Integer] -> Count Any
forall a. [Integer] -> Count a
Count [Integer]
xs Count Any -> Int -> Integer
forall a. Count a -> Int -> Integer
!!* (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

-- Undecidable for some 0-lists, for instance datatype with only infinite values
-- instance Eq (Count a) where
--  a == b = f a == f b
--    where f = count . compact

-- Typically infinite, perhaps it should have some hard-coded limit.
--instance Show (Count a) where
--  show = show . count


instance Functor Count where
  fmap :: (a -> b) -> Count a -> Count b
fmap a -> b
_ (Count [Integer]
xs) = [Integer] -> Count b
forall a. [Integer] -> Count a
Count [Integer]
xs

instance Applicative Count where
  pure :: a -> Count a
pure a
_ = [Integer] -> Count a
forall a. [Integer] -> Count a
Count [Integer
1]

  (Count [])  <*> :: Count (a -> b) -> Count a -> Count b
<*> (Count [Integer]
_)      = Count b
forall (f :: * -> *) a. Alternative f => f a
empty
  (Count [Integer]
_)  <*> (Count [])      = Count b
forall (f :: * -> *) a. Alternative f => f a
empty
  (Count (Integer
0:[Integer]
xs)) <*> Count a
ys             = Count b -> Count b
forall (f :: * -> *) a. Sized f => f a -> f a
pay (Count b -> Count b) -> Count b -> Count b
forall a b. (a -> b) -> a -> b
$ [Integer] -> Count (a -> b)
forall a. [Integer] -> Count a
Count [Integer]
xs Count (a -> b) -> Count a -> Count b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Count a
ys
  Count (a -> b)
xs <*> (Count (Integer
0:[Integer]
ys))             = Count b -> Count b
forall (f :: * -> *) a. Sized f => f a -> f a
pay (Count b -> Count b) -> Count b -> Count b
forall a b. (a -> b) -> a -> b
$ Count (a -> b)
xs Count (a -> b) -> Count a -> Count b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Integer] -> Count a
forall a. [Integer] -> Count a
Count [Integer]
ys
  (Count xs0 :: [Integer]
xs0@(Integer
_:[Integer]
xs0'))  <*> (Count [Integer]
ys)  = [Integer] -> Count b
forall a. [Integer] -> Count a
Count ([Integer] -> Count b) -> [Integer] -> Count b
forall a b. (a -> b) -> a -> b
$ [[Integer]] -> [Integer]
run (Int -> [[Integer]] -> [[Integer]]
forall a. Int -> [a] -> [a]
drop Int
1 ([[Integer]] -> [[Integer]]) -> [[Integer]] -> [[Integer]]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [[Integer]]
forall a. [a] -> [[a]]
reversals' [Integer]
ys) where
    mult :: [Integer] -> Integer
mult = [Integer] -> [Integer] -> Integer
conv [Integer]
xs0
    run :: [[Integer]] -> [Integer]
run []     = []
    run ([Integer]
r:[[Integer]]
rs) = [Integer] -> [[Integer]] -> [Integer]
go [Integer]
r [[Integer]]
rs
    go :: [Integer] -> [[Integer]] -> [Integer]
go [Integer]
r [[Integer]]
rs  = [Integer] -> Integer
mult [Integer]
r Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:  case [[Integer]]
rs of
                           [] -> [Integer] -> [Integer] -> [Integer]
go' [Integer]
r [Integer]
xs0'
                           ([Integer]
r':[[Integer]]
rs') -> [Integer] -> [[Integer]] -> [Integer]
go [Integer]
r' [[Integer]]
rs'
    go' :: [Integer] -> [Integer] -> [Integer]
go' [Integer]
r []         = []
    go' [Integer]
r xs :: [Integer]
xs@(Integer
_:[Integer]
xs') = [Integer] -> [Integer] -> Integer
conv [Integer]
r [Integer]
xs Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer] -> [Integer] -> [Integer]
go' [Integer]
r [Integer]
xs'

instance Alternative Count where
  empty :: Count a
empty = [Integer] -> Count a
forall a. [Integer] -> Count a
Count []
  ~(Count [Integer]
xs) <|> :: Count a -> Count a -> Count a
<|> ~(Count [Integer]
ys) = [Integer] -> Count a
forall a. [Integer] -> Count a
Count ([Integer] -> Count a) -> [Integer] -> Count a
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer]
forall a. (a -> a -> a) -> [a] -> [a] -> [a]
zipWithL Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) [Integer]
xs [Integer]
ys where
    zipWithL :: (a -> a -> a) -> [a] -> [a] -> [a]
zipWithL a -> a -> a
f (a
x:[a]
xs) (a
y:[a]
ys) = a -> a -> a
f a
x a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> a) -> [a] -> [a] -> [a]
zipWithL a -> a -> a
f [a]
xs [a]
ys
    zipWithL a -> a -> a
_ [] [a]
ys = [a]
ys
    zipWithL a -> a -> a
_ [a]
xs [] = [a]
xs

instance Semigroup (Count a) where
  <> :: Count a -> Count a -> Count a
(<>) = Count a -> Count a -> Count a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Monoid (Count a) where
  mempty :: Count a
mempty = Count a
forall (f :: * -> *) a. Alternative f => f a
empty

instance Sized Count where
  pay :: Count a -> Count a
pay    = [Integer] -> Count a
forall a. [Integer] -> Count a
Count ([Integer] -> Count a)
-> (Count a -> [Integer]) -> Count a -> Count a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
0Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:) ([Integer] -> [Integer])
-> (Count a -> [Integer]) -> Count a -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Count a -> [Integer]
forall a. Count a -> [Integer]
count
  fin :: Integer -> Count Integer
fin Integer
i  = [Integer] -> Count Integer
forall a. [Integer] -> Count a
Count [Integer
i]
  aconcat :: [Count a] -> Count a
aconcat []  = Count a
forall (f :: * -> *) a. Alternative f => f a
empty
  aconcat [Count a
x] = Count a
x
  aconcat [Count a
x,Count a
y] = Count a
x Count a -> Count a -> Count a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Count a
y
  aconcat [Count a]
xss = [Integer] -> Count a
forall a. [Integer] -> Count a
Count ([Integer] -> Count a) -> [Integer] -> Count a
forall a b. (a -> b) -> a -> b
$ ([Integer] -> Integer) -> [[Integer]] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([[Integer]] -> [Integer]) -> [[Integer]] -> [Integer]
forall a b. (a -> b) -> a -> b
$ [[Integer]] -> [[Integer]]
forall a. [[a]] -> [[a]]
transpose ((Count a -> [Integer]) -> [Count a] -> [[Integer]]
forall a b. (a -> b) -> [a] -> [b]
map Count a -> [Integer]
forall a. Count a -> [Integer]
count [Count a]
xss)

{-
  finBits i | i <= 0  = Count []
  finBits i           = Count $ 1 : go 1 where
    go n | n <= lim      = n : go (2*n)
    go n | n >= i        = []
    go n                 = [i-n]
    lim = i `div` 2
-}

infixl 3 <->
(Count [Integer]
xs) <-> :: Count a -> Count a -> Count a
<-> (Count [Integer]
ys) = [Integer] -> Count a
forall a. [Integer] -> Count a
Count ([Integer] -> Count a) -> [Integer] -> Count a
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer]
forall t t. (t -> t -> t) -> [t] -> [t] -> [t]
zipWithLL Integer -> Integer -> Integer
forall a. (Ord a, Num a) => a -> a -> a
op [Integer]
xs [Integer]
ys where
  op :: a -> a -> a
op a
n a
m = a -> a -> a
forall a. Ord a => a -> a -> a
max a
0 (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
m)
  zipWithLL :: (t -> t -> t) -> [t] -> [t] -> [t]
zipWithLL t -> t -> t
f [t]
xs []         = [t]
xs
  zipWithLL t -> t -> t
f [] [t]
_          = []
  zipWithLL t -> t -> t
f (t
x:[t]
xs) (t
y:[t]
ys) = t -> t -> t
f t
x t
y t -> [t] -> [t]
forall a. a -> [a] -> [a]
: (t -> t -> t) -> [t] -> [t] -> [t]
zipWithLL t -> t -> t
f [t]
xs [t]
ys

infixl 4 </>
(</>) :: Count a -> Count a -> Count a
(Count [Integer]
xs)   </> :: Count a -> Count a -> Count a
</> (Count [])      = String -> Count a
forall a. HasCallStack => String -> a
error String
"Vector division by zero"
(Count [Integer]
xs)   </> (Count (Integer
0:[Integer]
ys))  = [Integer] -> Count a
forall a. [Integer] -> Count a
Count (Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
drop Int
1 [Integer]
xs) Count a -> Count a -> Count a
forall a. Count a -> Count a -> Count a
</> [Integer] -> Count a
forall a. [Integer] -> Count a
Count [Integer]
ys
(Count [Integer]
xs0)  </> (Count (Integer
y:[Integer]
ys0)) = [Integer] -> Count a
forall a. [Integer] -> Count a
Count [Integer]
ds where
  ds :: [Integer]
ds = [Integer] -> [[Integer]] -> [Integer]
go [Integer]
xs0 ([Integer] -> [[Integer]]
forall a. [a] -> [[a]]
reversals' [Integer]
ys0)
  go :: [Integer] -> [[Integer]] -> [Integer]
go [] [[Integer]]
yrs          = []
  go ([Integer]
xs) []         = [Integer] -> [Integer] -> [Integer]
go' [Integer]
xs ([Integer] -> [Integer]
forall a. [a] -> [a]
tail [Integer]
ds)
  go (Integer
x:[Integer]
xs) ([Integer]
yr:[[Integer]]
yrs) =  ((Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- [Integer] -> [Integer] -> Integer
conv [Integer]
yr [Integer]
ds) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
y) Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer] -> [[Integer]] -> [Integer]
go [Integer]
xs [[Integer]]
yrs

  revy :: [Integer]
revy = [Integer] -> [Integer]
forall a. [a] -> [a]
reverse [Integer]
ys0
  go' :: [Integer] -> [Integer] -> [Integer]
go' [] [Integer]
_ = []
  go' (Integer
x:[Integer]
xs) ([Integer]
ds') = ((Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- ([Integer] -> [Integer] -> Integer
conv [Integer]
revy [Integer]
ds' )) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
y) Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer] -> [Integer] -> [Integer]
go' [Integer]
xs ([Integer] -> [Integer]
forall a. [a] -> [a]
tail [Integer]
ds')

-- Yap is the inverse of pay.
yap :: Count a -> Count a
yap :: Count a -> Count a
yap (Count [Integer]
xs) = [Integer] -> Count a
forall a. [Integer] -> Count a
Count (Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
drop Int
1 [Integer]
xs)


reversals' :: [a] -> [[a]]
reversals' :: [a] -> [[a]]
reversals' = [a] -> [a] -> [[a]]
forall a. [a] -> [a] -> [[a]]
go [] where
  go :: [a] -> [a] -> [[a]]
go [a]
rs [a]
xs = [a]
rs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: case [a]
xs of
      [] -> []
      (a
x:[a]
xs) -> [a] -> [a] -> [[a]]
go (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs) [a]
xs


first :: Int -> Count a -> Count a
first Int
k = [Integer] -> Count a
forall a. [Integer] -> Count a
Count ([Integer] -> Count a)
-> (Count a -> [Integer]) -> Count a -> Count a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take Int
k ([Integer] -> [Integer])
-> (Count a -> [Integer]) -> Count a -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ Integer -> [Integer]
forall a. a -> [a]
repeat Integer
0) ([Integer] -> [Integer])
-> (Count a -> [Integer]) -> Count a -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Count a -> [Integer]
forall a. Count a -> [Integer]
count
rev :: Count a -> Count a
rev Count a
x = [Integer] -> Count a
forall a. [Integer] -> Count a
Count ([Integer] -> Count a) -> [Integer] -> Count a
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Integer]
forall a. [a] -> [a]
reverse ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Count a -> [Integer]
forall a. Count a -> [Integer]
count Count a
x

-- Dissapointingly, this is the fastest version of conv I have discovered so far
conv :: [Integer] -> [Integer] -> Integer
conv :: [Integer] -> [Integer] -> Integer
conv [Integer]
xs = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer)
-> ([Integer] -> [Integer]) -> [Integer] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*) [Integer]
xs
{-#INLINE conv#-}

conv' :: [Integer] -> [Integer] -> Integer
conv' :: [Integer] -> [Integer] -> Integer
conv' (Integer
_:[Integer]
xs) (Integer
0:[Integer]
ys) = [Integer] -> [Integer] -> Integer
conv' [Integer]
xs [Integer]
ys
conv' (Integer
0:[Integer]
xs) (Integer
_:[Integer]
ys) = [Integer] -> [Integer] -> Integer
conv' [Integer]
xs [Integer]
ys
conv' [Integer]
xs     [Integer]
ys = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Integer -> Integer -> Integer)
-> [Integer] -> [Integer] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*) [Integer]
xs [Integer]
ys)
{-#INLINE conv'#-}


cardTake :: Int -> Count a -> Count a
cardTake :: Int -> Count a -> Count a
cardTake Int
k (Count [Integer]
xs) = [Integer] -> Count a
forall a. [Integer] -> Count a
Count (Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take Int
k [Integer]
xs)

cardRev :: Count a -> Count a
cardRev :: Count a -> Count a
cardRev (Count [Integer]
xs) = [Integer] -> Count a
forall a. [Integer] -> Count a
Count ([Integer] -> [Integer]
forall a. [a] -> [a]
reverse [Integer]
xs)
-------------------------------------
-- Specialized products and divisions
-------------------------------------

strict :: Count a -> Count a
strict :: Count a -> Count a
strict (Count [Integer]
xs) = [Integer] -> Count a
forall a. [Integer] -> Count a
Count ([Integer] -> Count a) -> [Integer] -> Count a
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Integer]
strictL [Integer]
xs

strictL :: [Integer] -> [Integer]
strictL :: [Integer] -> [Integer]
strictL [Integer]
xs = (Integer -> [Integer] -> [Integer])
-> [Integer] -> [Integer] -> [Integer]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Integer -> [Integer] -> [Integer]
seq [Integer]
xs [Integer]
xs

cap :: Int -> Count a -> Count a
cap :: Int -> Count a -> Count a
cap Int
k Count a
c = Count a -> Count a
forall a. Count a -> Count a
strict (Int -> Count a -> Count a
forall a. Int -> Count a -> Count a
cardTake (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Count a
c)

-- Computes the k'th index in a product
mult :: Count a -> Count b -> Int -> Integer
-- mult (Count [1]) cl n = cl !!* n
-- mult cl (Count [1]) n = cl !!* n
-- mult (Count (0:xs)) cl n = mult (Count xs) cl (n-1)
mult :: Count a -> Count b -> Int -> Integer
mult Count a
cl (Count [Integer
1]) Int
n = Count a
cl Count a -> Int -> Integer
forall a. Count a -> Int -> Integer
!!* Int
n
mult Count a
cl1 Count b
cl2 Int
n           = [Integer] -> [Integer] -> Integer
conv [Integer]
sub1 [Integer]
rev where
  sub2 :: [Integer]
sub2 = Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Count b -> [Integer]
forall a. Count a -> [Integer]
count Count b
cl2
  rl :: Int
rl = [Integer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
sub2
  rev :: [Integer]
rev = [Integer] -> [Integer]
forall a. [a] -> [a]
reverse [Integer]
sub2
  sub1 :: [Integer]
sub1 = Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
rl) (Count a -> [Integer]
forall a. Count a -> [Integer]
count Count a
cl1)


prodsK, prodsK' :: [Count a] -> Int -> Count a
prodsK :: [Count a] -> Int -> Count a
prodsK []  Int
_  = [Integer] -> Count a
forall a. [Integer] -> Count a
Count [Integer
1]
prodsK [Count a
x] Int
k  = Count a
x  -- No length guarantee
prodsK [Count a]
xs Int
k   = Count a -> Count a
forall a. Count a -> Count a
cardRev (Count a -> Count a) -> Count a -> Count a
forall a b. (a -> b) -> a -> b
$ [Count a] -> Int -> Count a
forall a. [Count a] -> Int -> Count a
prodsKR [Count a]
xs Int
k
-- Produces the reversed K-product of all given lists
-- By removing all pays we get a much smaller actual k for the products.
-- Intermediate lists need to be freed up for garbage collection.
prodsKR :: [Count a] -> Int -> Count a
--prodsKR []              k  = Count [1]
prodsKR :: [Count a] -> Int -> Count a
prodsKR (Count [Integer]
x:[Count a]
xs) Int
k  = Count a -> Count a
forall a. Count a -> Count a
strict (Count a -> Count a) -> Count a -> Count a
forall a b. (a -> b) -> a -> b
$
  [Integer] -> Count a
forall a. [Integer] -> Count a
Count ([Integer] -> Count a) -> [Integer] -> Count a
forall a b. (a -> b) -> a -> b
$ ([Integer] -> Count a -> [Integer])
-> [Integer] -> [Count a] -> [Integer]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Integer] -> Count a -> [Integer]
forall a. [Integer] -> Count a -> [Integer]
prodR ([Integer] -> [Integer]
forall a. [a] -> [a]
reverse ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([Integer]
x [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ Integer -> [Integer]
forall a. a -> [a]
repeat Integer
0)) [Count a]
xs where

  (Int
xs', [Count a]
p) = Int -> [Count a] -> [Count a] -> (Int, [Count a])
forall a a. Int -> [Count a] -> [Count a] -> (Int, [Count a])
baseCosts Int
0 [] [Count a]
xs


  prodR :: [Integer] -> Count a -> [Integer]
--  prodR [] _                  = []
--  prodR r@(_,r') (Count x) = conv x r : prodR r x
  prodR :: [Integer] -> Count a -> [Integer]
prodR [Integer]
rs (Count [Integer]
x) = ([Integer] -> Integer) -> [[Integer]] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ([Integer] -> [Integer] -> Integer
conv [Integer]
x) ([Integer] -> [[Integer]]
forall a. [a] -> [[a]]
initTails [Integer]
rs)

prodsK' :: [Count a] -> Int -> Count a
prodsK' [Count a]
xs0 Int
k = Int -> Count a -> Count a
forall a. Int -> Count a -> Count a
cap Int
k (Count a -> Count a) -> Count a -> Count a
forall a b. (a -> b) -> a -> b
$ [Count a] -> Count a
forall a. [Count a] -> Count a
go [Count a]
xs0 where
  go :: [Count a] -> Count a
go []     = [Integer] -> Count a
forall a. [Integer] -> Count a
Count [Integer
1]
  go [Count a
x]    = Count a
x
  go (Count a
x:[Count a]
xs) = Count a -> Count (a -> a)
forall a b. Count a -> Count b
untyped Count a
x Count (a -> a) -> Count a -> Count a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Count a] -> Count a
go [Count a]
xs


-- prop_ProdsK k cls = prodsK smallK cls ==
--  smallK = k `mod` 20

ultraDiv :: [Count ()] -> [Count ()] -> Int -> Count ()
ultraDiv :: [Count ()] -> [Count ()] -> Int -> Count ()
ultraDiv [Count ()]
xs [Count ()]
ys Int
k = let
  x :: Count ()
x = Count () -> Count ()
forall a. Count a -> Count a
cardRev ([Count ()] -> Int -> Count ()
forall a. [Count a] -> Int -> Count a
prodsKR [Count ()]
xs Int
k)
  y :: Count ()
y = Count () -> Count ()
forall a. Count a -> Count a
cardRev ([Count ()] -> Int -> Count ()
forall a. [Count a] -> Int -> Count a
prodsKR [Count ()]
ys Int
k)
  in Int -> Count () -> Count ()
forall a. Int -> Count a -> Count a
cap Int
k (Count () -> Count ()) -> Count () -> Count ()
forall a b. (a -> b) -> a -> b
$ Count ()
x Count () -> Count () -> Count ()
forall a. Count a -> Count a -> Count a
</> Count ()
y

initTails :: [a] -> [[a]]
initTails :: [a] -> [[a]]
initTails [] = []
initTails xs :: [a]
xs@(a
_:[a]
xs') = [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. [a] -> [[a]]
initTails [a]
xs'

baseCosts :: Int -> [Count a] -> [Count a] -> (Int, [Count a])
baseCosts Int
acc1 [Count a]
acc2 []     = (Int
acc1,[Count a]
acc2)
baseCosts Int
acc1 [Count a]
acc2 (Count [Integer]
x:[Count a]
xs) = Int -> [Count a] -> [Count a] -> (Int, [Count a])
baseCosts (Int
acc1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Integer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
zs) ([Integer] -> Count a
forall a. [Integer] -> Count a
Count [Integer]
x' Count a -> [Count a] -> [Count a]
forall a. a -> [a] -> [a]
: [Count a]
acc2) [Count a]
xs where
    ([Integer]
zs, [Integer]
x') = (Integer -> Bool) -> [Integer] -> ([Integer], [Integer])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/=Integer
0) [Integer]
x








{-
-- Testing
prop_multTerm a b (NonNegative n) = (count (a <*> b)) !!* n == mult a b n where
  [] !!* n = 0
  (x:xs) !!* 0 = x
  (x:xs) !!* n = xs !!* (n-1)

prop_multCom a b = (untyped a <*> b) == (untyped b <*> a)

prop_div :: Count (a -> a) -> Count a -> Property
prop_div a b = any (/= 0) (count b) ==> ((a <*> b) </> b) == untyped a

prop_div_id a = any (/= 0) (count a) ==> (a </> a) == pure ()
-}