{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE TypeOperators #-}

module AOC.Common.FinitarySet (
    FinitarySet(..)
  , empty, singleton, insert, delete, fromList, toList
  , intersection, union, unions, difference, (\\)
  , isSubsetOf, isProperSubsetOf, disjoint
  , size, member, notMember, null
  , cartesianProduct, disjointUnion
  , foldr, foldr', foldl, foldl', map, foldMap, filter
  , alterF, generate, powerSet, mapMaybe
  , partition
  ) where

import           Control.DeepSeq                    (NFData)
import           Data.Bifunctor
import           Data.Bit
import           Data.Bits
import           Data.Finitary
import           Data.Finite
import           Data.Functor
import           GHC.Generics                       (Generic)
import           GHC.TypeNats
import           Prelude                            (Bool(..), Maybe(..), Either(..), Int, Monoid, Eq(..), Ord, Show, (&&), ($), (.), otherwise, Semigroup(..), not, fromIntegral, id)
import qualified Data.List                          as L
import qualified Data.Maybe                         as M
import qualified Data.Vector.Generic.Sized.Internal as VG
import qualified Data.Vector.Unboxed.Sized          as V
import qualified Prelude                            as P

newtype FinitarySet a = FinitarySet (V.Vector (Cardinality a) Bit)
  deriving (Int -> FinitarySet a -> ShowS
[FinitarySet a] -> ShowS
FinitarySet a -> String
(Int -> FinitarySet a -> ShowS)
-> (FinitarySet a -> String)
-> ([FinitarySet a] -> ShowS)
-> Show (FinitarySet a)
forall a. Int -> FinitarySet a -> ShowS
forall a. [FinitarySet a] -> ShowS
forall a. FinitarySet a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FinitarySet a] -> ShowS
$cshowList :: forall a. [FinitarySet a] -> ShowS
show :: FinitarySet a -> String
$cshow :: forall a. FinitarySet a -> String
showsPrec :: Int -> FinitarySet a -> ShowS
$cshowsPrec :: forall a. Int -> FinitarySet a -> ShowS
Show, (forall x. FinitarySet a -> Rep (FinitarySet a) x)
-> (forall x. Rep (FinitarySet a) x -> FinitarySet a)
-> Generic (FinitarySet a)
forall x. Rep (FinitarySet a) x -> FinitarySet a
forall x. FinitarySet a -> Rep (FinitarySet a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FinitarySet a) x -> FinitarySet a
forall a x. FinitarySet a -> Rep (FinitarySet a) x
$cto :: forall a x. Rep (FinitarySet a) x -> FinitarySet a
$cfrom :: forall a x. FinitarySet a -> Rep (FinitarySet a) x
Generic, FinitarySet a -> FinitarySet a -> Bool
(FinitarySet a -> FinitarySet a -> Bool)
-> (FinitarySet a -> FinitarySet a -> Bool) -> Eq (FinitarySet a)
forall a. FinitarySet a -> FinitarySet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FinitarySet a -> FinitarySet a -> Bool
$c/= :: forall a. FinitarySet a -> FinitarySet a -> Bool
== :: FinitarySet a -> FinitarySet a -> Bool
$c== :: forall a. FinitarySet a -> FinitarySet a -> Bool
Eq, Eq (FinitarySet a)
Eq (FinitarySet a)
-> (FinitarySet a -> FinitarySet a -> Ordering)
-> (FinitarySet a -> FinitarySet a -> Bool)
-> (FinitarySet a -> FinitarySet a -> Bool)
-> (FinitarySet a -> FinitarySet a -> Bool)
-> (FinitarySet a -> FinitarySet a -> Bool)
-> (FinitarySet a -> FinitarySet a -> FinitarySet a)
-> (FinitarySet a -> FinitarySet a -> FinitarySet a)
-> Ord (FinitarySet a)
FinitarySet a -> FinitarySet a -> Bool
FinitarySet a -> FinitarySet a -> Ordering
FinitarySet a -> FinitarySet a -> FinitarySet a
forall a. Eq (FinitarySet a)
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
forall a. FinitarySet a -> FinitarySet a -> Bool
forall a. FinitarySet a -> FinitarySet a -> Ordering
forall a. FinitarySet a -> FinitarySet a -> FinitarySet a
min :: FinitarySet a -> FinitarySet a -> FinitarySet a
$cmin :: forall a. FinitarySet a -> FinitarySet a -> FinitarySet a
max :: FinitarySet a -> FinitarySet a -> FinitarySet a
$cmax :: forall a. FinitarySet a -> FinitarySet a -> FinitarySet a
>= :: FinitarySet a -> FinitarySet a -> Bool
$c>= :: forall a. FinitarySet a -> FinitarySet a -> Bool
> :: FinitarySet a -> FinitarySet a -> Bool
$c> :: forall a. FinitarySet a -> FinitarySet a -> Bool
<= :: FinitarySet a -> FinitarySet a -> Bool
$c<= :: forall a. FinitarySet a -> FinitarySet a -> Bool
< :: FinitarySet a -> FinitarySet a -> Bool
$c< :: forall a. FinitarySet a -> FinitarySet a -> Bool
compare :: FinitarySet a -> FinitarySet a -> Ordering
$ccompare :: forall a. FinitarySet a -> FinitarySet a -> Ordering
Ord)

instance (Finitary a, KnownNat (2 ^ Cardinality a)) => Finitary (FinitarySet a)
instance NFData (FinitarySet a)

foldr :: Finitary a => (a -> b -> b) -> b -> FinitarySet a -> b
foldr :: forall a b. Finitary a => (a -> b -> b) -> b -> FinitarySet a -> b
foldr a -> b -> b
f b
z (FinitarySet Vector (Cardinality a) Bit
xs) =
    (Finite (Cardinality a) -> Bit -> b -> b)
-> b -> Vector (Cardinality a) Bit -> b
forall a (n :: Nat) b.
Unbox a =>
(Finite n -> a -> b -> b) -> b -> Vector n a -> b
V.ifoldr (\Finite (Cardinality a)
i (Bit Bool
x) -> if Bool
x then a -> b -> b
f (Finite (Cardinality a) -> a
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite Finite (Cardinality a)
i) else b -> b
forall a. a -> a
id) b
z Vector (Cardinality a) Bit
xs
{-# INLINE foldr #-}

foldr' :: Finitary a => (a -> b -> b) -> b -> FinitarySet a -> b
foldr' :: forall a b. Finitary a => (a -> b -> b) -> b -> FinitarySet a -> b
foldr' a -> b -> b
f b
z (FinitarySet Vector (Cardinality a) Bit
xs) =
    (Finite (Cardinality a) -> Bit -> b -> b)
-> b -> Vector (Cardinality a) Bit -> b
forall a (n :: Nat) b.
Unbox a =>
(Finite n -> a -> b -> b) -> b -> Vector n a -> b
V.ifoldr' (\Finite (Cardinality a)
i (Bit Bool
x) -> if Bool
x then a -> b -> b
f (Finite (Cardinality a) -> a
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite Finite (Cardinality a)
i) else b -> b
forall a. a -> a
id) b
z Vector (Cardinality a) Bit
xs
{-# INLINE foldr' #-}

foldl :: Finitary a => (b -> a -> b) -> b -> FinitarySet a -> b
foldl :: forall a b. Finitary a => (b -> a -> b) -> b -> FinitarySet a -> b
foldl b -> a -> b
f b
z (FinitarySet Vector (Cardinality a) Bit
xs) =
    (b -> Finite (Cardinality a) -> Bit -> b)
-> b -> Vector (Cardinality a) Bit -> b
forall b a (n :: Nat).
Unbox b =>
(a -> Finite n -> b -> a) -> a -> Vector n b -> a
V.ifoldl (\b
r Finite (Cardinality a)
i (Bit Bool
x) -> if Bool
x then b -> a -> b
f b
r (Finite (Cardinality a) -> a
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite Finite (Cardinality a)
i) else b
r) b
z Vector (Cardinality a) Bit
xs
{-# INLINE foldl #-}

foldl' :: Finitary a => (b -> a -> b) -> b -> FinitarySet a -> b
foldl' :: forall a b. Finitary a => (b -> a -> b) -> b -> FinitarySet a -> b
foldl' b -> a -> b
f b
z (FinitarySet Vector (Cardinality a) Bit
xs) =
    (b -> Finite (Cardinality a) -> Bit -> b)
-> b -> Vector (Cardinality a) Bit -> b
forall b a (n :: Nat).
Unbox b =>
(a -> Finite n -> b -> a) -> a -> Vector n b -> a
V.ifoldl' (\b
r Finite (Cardinality a)
i (Bit Bool
x) -> if Bool
x then b -> a -> b
f b
r (Finite (Cardinality a) -> a
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite Finite (Cardinality a)
i) else b
r) b
z Vector (Cardinality a) Bit
xs
{-# INLINE foldl' #-}

map :: (Finitary a, Finitary b) => (a -> b) -> FinitarySet a -> FinitarySet b
map :: forall a b.
(Finitary a, Finitary b) =>
(a -> b) -> FinitarySet a -> FinitarySet b
map a -> b
f = [b] -> FinitarySet b
forall a. Finitary a => [a] -> FinitarySet a
fromList ([b] -> FinitarySet b)
-> (FinitarySet a -> [b]) -> FinitarySet a -> FinitarySet b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ([a] -> [b]) -> (FinitarySet a -> [a]) -> FinitarySet a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinitarySet a -> [a]
forall a. Finitary a => FinitarySet a -> [a]
toList
{-# INLINE map #-}

foldMap :: (Finitary a, Monoid m) => (a -> m) -> FinitarySet a -> m
foldMap :: forall a m.
(Finitary a, Monoid m) =>
(a -> m) -> FinitarySet a -> m
foldMap a -> m
f = (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
P.foldMap a -> m
f ([a] -> m) -> (FinitarySet a -> [a]) -> FinitarySet a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinitarySet a -> [a]
forall a. Finitary a => FinitarySet a -> [a]
toList
{-# INLINE foldMap #-}

toList :: Finitary a => FinitarySet a -> [a]
toList :: forall a. Finitary a => FinitarySet a -> [a]
toList = (a -> [a] -> [a]) -> [a] -> FinitarySet a -> [a]
forall a b. Finitary a => (a -> b -> b) -> b -> FinitarySet a -> b
foldr (:) []
{-# INLINE toList #-}

empty :: KnownNat (Cardinality a) => FinitarySet a
empty :: forall a. KnownNat (Cardinality a) => FinitarySet a
empty = Vector (Cardinality a) Bit -> FinitarySet a
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector (Cardinality a) Bit -> FinitarySet a)
-> Vector (Cardinality a) Bit -> FinitarySet a
forall a b. (a -> b) -> a -> b
$ Bit -> Vector (Cardinality a) Bit
forall (n :: Nat) a. (KnownNat n, Unbox a) => a -> Vector n a
V.replicate (Bool -> Bit
Bit Bool
False)
{-# INLINE empty #-}

-- could be made unsafe
singleton :: Finitary a => a -> FinitarySet a
singleton :: forall a. Finitary a => a -> FinitarySet a
singleton a
x = Vector (Cardinality a) Bit -> FinitarySet a
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector (Cardinality a) Bit -> FinitarySet a)
-> Vector (Cardinality a) Bit -> FinitarySet a
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Cardinality a) Bit
forall a. Bits a => Int -> a
bit (Finite (Cardinality a) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite a
x))
{-# INLINE singleton #-}

fromList :: Finitary a => [a] -> FinitarySet a
fromList :: forall a. Finitary a => [a] -> FinitarySet a
fromList [a]
xs = Vector (Cardinality a) Bit -> FinitarySet a
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector (Cardinality a) Bit -> FinitarySet a)
-> Vector (Cardinality a) Bit -> FinitarySet a
forall a b. (a -> b) -> a -> b
$
    Vector (Cardinality a) Bit
0 Vector (Cardinality a) Bit
-> [(Finite (Cardinality a), Bit)] -> Vector (Cardinality a) Bit
forall a (m :: Nat).
Unbox a =>
Vector m a -> [(Finite m, a)] -> Vector m a
V.// (a -> (Finite (Cardinality a), Bit))
-> [a] -> [(Finite (Cardinality a), Bit)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> (Finite (Cardinality a), Bit)
forall {a}. Finitary a => a -> (Finite (Cardinality a), Bit)
go [a]
xs
  where
    go :: a -> (Finite (Cardinality a), Bit)
go a
x = (a -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite a
x, Bool -> Bit
Bit Bool
True)
{-# INLINE fromList #-}

intersection :: FinitarySet a -> FinitarySet a -> FinitarySet a
intersection :: forall a. FinitarySet a -> FinitarySet a -> FinitarySet a
intersection (FinitarySet (VG.Vector Vector Bit
xs)) (FinitarySet (VG.Vector Vector Bit
ys)) = Vector Vector (Cardinality a) Bit -> FinitarySet a
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector Bit -> Vector Vector (Cardinality a) Bit
forall (v :: Type -> Type) (n :: Nat) a. v a -> Vector v n a
VG.Vector (Vector Bit
xs Vector Bit -> Vector Bit -> Vector Bit
forall a. Bits a => a -> a -> a
.&. Vector Bit
ys))
{-# INLINE intersection #-}

union :: FinitarySet a -> FinitarySet a -> FinitarySet a
union :: forall a. FinitarySet a -> FinitarySet a -> FinitarySet a
union (FinitarySet (VG.Vector Vector Bit
xs)) (FinitarySet (VG.Vector Vector Bit
ys)) = Vector Vector (Cardinality a) Bit -> FinitarySet a
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector Bit -> Vector Vector (Cardinality a) Bit
forall (v :: Type -> Type) (n :: Nat) a. v a -> Vector v n a
VG.Vector (Vector Bit
xs Vector Bit -> Vector Bit -> Vector Bit
forall a. Bits a => a -> a -> a
.|. Vector Bit
ys))
{-# INLINE union #-}

unions :: Finitary a => [FinitarySet a] -> FinitarySet a
unions :: forall a. Finitary a => [FinitarySet a] -> FinitarySet a
unions = (FinitarySet a -> FinitarySet a -> FinitarySet a)
-> FinitarySet a -> [FinitarySet a] -> FinitarySet a
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' FinitarySet a -> FinitarySet a -> FinitarySet a
forall a. FinitarySet a -> FinitarySet a -> FinitarySet a
union FinitarySet a
forall a. KnownNat (Cardinality a) => FinitarySet a
empty
{-# INLINE unions #-}

insert :: Finitary a => a -> FinitarySet a -> FinitarySet a
insert :: forall a. Finitary a => a -> FinitarySet a -> FinitarySet a
insert a
x (FinitarySet Vector (Cardinality a) Bit
xs) = Vector (Cardinality a) Bit -> FinitarySet a
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector (Cardinality a) Bit -> FinitarySet a)
-> Vector (Cardinality a) Bit -> FinitarySet a
forall a b. (a -> b) -> a -> b
$ Vector (Cardinality a) Bit
xs Vector (Cardinality a) Bit
-> [(Finite (Cardinality a), Bit)] -> Vector (Cardinality a) Bit
forall a (m :: Nat).
Unbox a =>
Vector m a -> [(Finite m, a)] -> Vector m a
V.// [(a -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite a
x, Bool -> Bit
Bit Bool
True)]
{-# INLINE insert #-}

delete :: Finitary a => a -> FinitarySet a -> FinitarySet a
delete :: forall a. Finitary a => a -> FinitarySet a -> FinitarySet a
delete a
x (FinitarySet Vector (Cardinality a) Bit
xs) = Vector (Cardinality a) Bit -> FinitarySet a
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector (Cardinality a) Bit -> FinitarySet a)
-> Vector (Cardinality a) Bit -> FinitarySet a
forall a b. (a -> b) -> a -> b
$ Vector (Cardinality a) Bit
xs Vector (Cardinality a) Bit
-> [(Finite (Cardinality a), Bit)] -> Vector (Cardinality a) Bit
forall a (m :: Nat).
Unbox a =>
Vector m a -> [(Finite m, a)] -> Vector m a
V.// [(a -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite a
x, Bool -> Bit
Bit Bool
False)]
{-# INLINE delete #-}

member :: Finitary a => a -> FinitarySet a -> Bool
member :: forall a. Finitary a => a -> FinitarySet a -> Bool
member a
x (FinitarySet Vector (Cardinality a) Bit
xs) = Bit -> Bool
unBit (Bit -> Bool) -> Bit -> Bool
forall a b. (a -> b) -> a -> b
$ Vector (Cardinality a) Bit
xs Vector (Cardinality a) Bit -> Finite (Cardinality a) -> Bit
forall (n :: Nat) a. Unbox a => Vector n a -> Finite n -> a
`V.index` a -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite a
x
{-# INLINE member #-}

notMember :: Finitary a => a -> FinitarySet a -> Bool
notMember :: forall a. Finitary a => a -> FinitarySet a -> Bool
notMember a
x = Bool -> Bool
not (Bool -> Bool) -> (FinitarySet a -> Bool) -> FinitarySet a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FinitarySet a -> Bool
forall a. Finitary a => a -> FinitarySet a -> Bool
member a
x
{-# INLINE notMember #-}

null :: FinitarySet a -> Bool
null :: forall a. FinitarySet a -> Bool
null (FinitarySet (VG.Vector Vector Bit
xs)) = Vector Bit -> Int
forall a. Bits a => a -> Int
popCount Vector Bit
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
{-# INLINE null #-}

size :: FinitarySet a -> Int
size :: forall a. FinitarySet a -> Int
size (FinitarySet (VG.Vector Vector Bit
xs)) = Vector Bit -> Int
forall a. Bits a => a -> Int
popCount Vector Bit
xs
{-# INLINE size #-}

isSubsetOf :: FinitarySet a -> FinitarySet a -> Bool
isSubsetOf :: forall a. FinitarySet a -> FinitarySet a -> Bool
isSubsetOf (FinitarySet (VG.Vector Vector Bit
xs)) (FinitarySet (VG.Vector Vector Bit
ys)) = (Vector Bit
xs Vector Bit -> Vector Bit -> Vector Bit
forall a. Bits a => a -> a -> a
.&. Vector Bit
ys) Vector Bit -> Vector Bit -> Bool
forall a. Eq a => a -> a -> Bool
== Vector Bit
xs
{-# INLINE isSubsetOf #-}

isProperSubsetOf :: FinitarySet a -> FinitarySet a -> Bool
isProperSubsetOf :: forall a. FinitarySet a -> FinitarySet a -> Bool
isProperSubsetOf (FinitarySet (VG.Vector Vector Bit
xs)) (FinitarySet (VG.Vector Vector Bit
ys)) =
      Vector Bit
xs Vector Bit -> Vector Bit -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector Bit
ys
   Bool -> Bool -> Bool
&& (Vector Bit
xs Vector Bit -> Vector Bit -> Vector Bit
forall a. Bits a => a -> a -> a
.&. Vector Bit
ys) Vector Bit -> Vector Bit -> Bool
forall a. Eq a => a -> a -> Bool
== Vector Bit
xs
{-# INLINE isProperSubsetOf #-}

disjoint :: FinitarySet a -> FinitarySet a -> Bool
disjoint :: forall a. FinitarySet a -> FinitarySet a -> Bool
disjoint FinitarySet a
xs FinitarySet a
ys = FinitarySet a -> Bool
forall a. FinitarySet a -> Bool
null (FinitarySet a
xs FinitarySet a -> FinitarySet a -> FinitarySet a
forall a. FinitarySet a -> FinitarySet a -> FinitarySet a
`intersection` FinitarySet a
ys)
{-# INLINE disjoint #-}

difference :: FinitarySet a -> FinitarySet a -> FinitarySet a
difference :: forall a. FinitarySet a -> FinitarySet a -> FinitarySet a
difference (FinitarySet (VG.Vector Vector Bit
xs)) (FinitarySet (VG.Vector Vector Bit
ys)) =
      Vector Vector (Cardinality a) Bit -> FinitarySet a
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector Bit -> Vector Vector (Cardinality a) Bit
forall (v :: Type -> Type) (n :: Nat) a. v a -> Vector v n a
VG.Vector (Vector Bit
xs Vector Bit -> Vector Bit -> Vector Bit
forall a. Bits a => a -> a -> a
.&. Vector Bit -> Vector Bit
forall a. Bits a => a -> a
complement Vector Bit
ys))
{-# INLINE difference #-}

(\\) :: FinitarySet a -> FinitarySet a -> FinitarySet a
\\ :: forall a. FinitarySet a -> FinitarySet a -> FinitarySet a
(\\) = FinitarySet a -> FinitarySet a -> FinitarySet a
forall a. FinitarySet a -> FinitarySet a -> FinitarySet a
difference
{-# INLINE (\\) #-}
infixl 9 \\

cartesianProduct
    :: (KnownNat (Cardinality a), KnownNat (Cardinality a * Cardinality b))
    => FinitarySet a
    -> FinitarySet b
    -> FinitarySet (a, b)
cartesianProduct :: forall a b.
(KnownNat (Cardinality a),
 KnownNat (Cardinality a * Cardinality b)) =>
FinitarySet a -> FinitarySet b -> FinitarySet (a, b)
cartesianProduct (FinitarySet Vector (Cardinality a) Bit
xs) (FinitarySet Vector (Cardinality b) Bit
ys) = Vector (Cardinality (a, b)) Bit -> FinitarySet (a, b)
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector (Cardinality (a, b)) Bit -> FinitarySet (a, b))
-> Vector (Cardinality (a, b)) Bit -> FinitarySet (a, b)
forall a b. (a -> b) -> a -> b
$ (Finite (Cardinality a * Cardinality b) -> Bit)
-> Vector (Cardinality a * Cardinality b) Bit
forall (n :: Nat) a.
(KnownNat n, Unbox a) =>
(Finite n -> a) -> Vector n a
V.generate ((Finite (Cardinality a * Cardinality b) -> Bit)
 -> Vector (Cardinality a * Cardinality b) Bit)
-> (Finite (Cardinality a * Cardinality b) -> Bit)
-> Vector (Cardinality a * Cardinality b) Bit
forall a b. (a -> b) -> a -> b
$ \Finite (Cardinality a * Cardinality b)
i ->
    let (Finite (Cardinality a)
j, Finite (Cardinality b)
k) = Finite (Cardinality a * Cardinality b)
-> (Finite (Cardinality a), Finite (Cardinality b))
forall (n :: Nat) (m :: Nat).
KnownNat n =>
Finite (n * m) -> (Finite n, Finite m)
separateProduct Finite (Cardinality a * Cardinality b)
i
    in  (Vector (Cardinality a) Bit
xs Vector (Cardinality a) Bit -> Finite (Cardinality a) -> Bit
forall (n :: Nat) a. Unbox a => Vector n a -> Finite n -> a
`V.index` Finite (Cardinality a)
j) Bit -> Bit -> Bit
forall a. Bits a => a -> a -> a
.&. (Vector (Cardinality b) Bit
ys Vector (Cardinality b) Bit -> Finite (Cardinality b) -> Bit
forall (n :: Nat) a. Unbox a => Vector n a -> Finite n -> a
`V.index` Finite (Cardinality b)
k)

disjointUnion :: FinitarySet a -> FinitarySet b -> FinitarySet (Either a b)
disjointUnion :: forall a b.
FinitarySet a -> FinitarySet b -> FinitarySet (Either a b)
disjointUnion (FinitarySet (VG.Vector Vector Bit
xs)) (FinitarySet (VG.Vector Vector Bit
ys)) =
    Vector (Cardinality (Either a b)) Bit -> FinitarySet (Either a b)
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector Bit -> Vector Vector (Cardinality a + Cardinality b) Bit
forall (v :: Type -> Type) (n :: Nat) a. v a -> Vector v n a
VG.Vector (Vector Bit
xs Vector Bit -> Vector Bit -> Vector Bit
forall a. Semigroup a => a -> a -> a
<> Vector Bit
ys))
{-# INLINE disjointUnion #-}

partition
    :: Finitary a
    => (a -> Bool)
    -> FinitarySet a
    -> (FinitarySet a, FinitarySet a)
partition :: forall a.
Finitary a =>
(a -> Bool) -> FinitarySet a -> (FinitarySet a, FinitarySet a)
partition a -> Bool
f = ([a] -> FinitarySet a)
-> ([a] -> FinitarySet a)
-> ([a], [a])
-> (FinitarySet a, FinitarySet a)
forall (p :: Type -> Type -> Type) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [a] -> FinitarySet a
forall a. Finitary a => [a] -> FinitarySet a
fromList [a] -> FinitarySet a
forall a. Finitary a => [a] -> FinitarySet a
fromList (([a], [a]) -> (FinitarySet a, FinitarySet a))
-> (FinitarySet a -> ([a], [a]))
-> FinitarySet a
-> (FinitarySet a, FinitarySet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition a -> Bool
f ([a] -> ([a], [a]))
-> (FinitarySet a -> [a]) -> FinitarySet a -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinitarySet a -> [a]
forall a. Finitary a => FinitarySet a -> [a]
toList
{-# INLINE partition #-}

mapMaybe
    :: (Finitary a, Finitary b)
    => (a -> Maybe b)
    -> FinitarySet a
    -> FinitarySet b
mapMaybe :: forall a b.
(Finitary a, Finitary b) =>
(a -> Maybe b) -> FinitarySet a -> FinitarySet b
mapMaybe a -> Maybe b
f = [b] -> FinitarySet b
forall a. Finitary a => [a] -> FinitarySet a
fromList ([b] -> FinitarySet b)
-> (FinitarySet a -> [b]) -> FinitarySet a -> FinitarySet b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
M.mapMaybe a -> Maybe b
f ([a] -> [b]) -> (FinitarySet a -> [a]) -> FinitarySet a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinitarySet a -> [a]
forall a. Finitary a => FinitarySet a -> [a]
toList
{-# INLINE mapMaybe #-}

powerSet
    :: (Finitary a, KnownNat (2 ^ Cardinality a))
    => FinitarySet a
    -> FinitarySet (FinitarySet a)
powerSet :: forall a.
(Finitary a, KnownNat (2 ^ Cardinality a)) =>
FinitarySet a -> FinitarySet (FinitarySet a)
powerSet = [FinitarySet a] -> FinitarySet (FinitarySet a)
forall a. Finitary a => [a] -> FinitarySet a
fromList ([FinitarySet a] -> FinitarySet (FinitarySet a))
-> (FinitarySet a -> [FinitarySet a])
-> FinitarySet a
-> FinitarySet (FinitarySet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> FinitarySet a) -> [[a]] -> [FinitarySet a]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> FinitarySet a
forall a. Finitary a => [a] -> FinitarySet a
fromList ([[a]] -> [FinitarySet a])
-> (FinitarySet a -> [[a]]) -> FinitarySet a -> [FinitarySet a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. [a] -> [[a]]
L.subsequences ([a] -> [[a]]) -> (FinitarySet a -> [a]) -> FinitarySet a -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinitarySet a -> [a]
forall a. Finitary a => FinitarySet a -> [a]
toList
{-# INLINE powerSet #-}

alterF
    :: (Finitary a, Functor f)
    => (Bool -> f Bool)
    -> a
    -> FinitarySet a
    -> f (FinitarySet a)
alterF :: forall a (f :: Type -> Type).
(Finitary a, Functor f) =>
(Bool -> f Bool) -> a -> FinitarySet a -> f (FinitarySet a)
alterF Bool -> f Bool
f a
x FinitarySet a
xs
    | a
x a -> FinitarySet a -> Bool
forall a. Finitary a => a -> FinitarySet a -> Bool
`member` FinitarySet a
xs = Bool -> f Bool
f Bool
True f Bool -> (Bool -> FinitarySet a) -> f (FinitarySet a)
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Bool
False -> a
x a -> FinitarySet a -> FinitarySet a
forall a. Finitary a => a -> FinitarySet a -> FinitarySet a
`delete` FinitarySet a
xs
        Bool
True  -> FinitarySet a
xs
    | Bool
otherwise     = Bool -> f Bool
f Bool
False f Bool -> (Bool -> FinitarySet a) -> f (FinitarySet a)
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Bool
False -> FinitarySet a
xs
        Bool
True  -> a
x a -> FinitarySet a -> FinitarySet a
forall a. Finitary a => a -> FinitarySet a -> FinitarySet a
`insert` FinitarySet a
xs

generate :: Finitary a => (a -> Bool) -> FinitarySet a
generate :: forall a. Finitary a => (a -> Bool) -> FinitarySet a
generate a -> Bool
f = Vector (Cardinality a) Bit -> FinitarySet a
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector (Cardinality a) Bit -> FinitarySet a)
-> Vector (Cardinality a) Bit -> FinitarySet a
forall a b. (a -> b) -> a -> b
$ (Finite (Cardinality a) -> Bit) -> Vector (Cardinality a) Bit
forall (n :: Nat) a.
(KnownNat n, Unbox a) =>
(Finite n -> a) -> Vector n a
V.generate (Bool -> Bit
Bit (Bool -> Bit)
-> (Finite (Cardinality a) -> Bool)
-> Finite (Cardinality a)
-> Bit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
f (a -> Bool)
-> (Finite (Cardinality a) -> a) -> Finite (Cardinality a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite (Cardinality a) -> a
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite)
{-# INLINE generate #-}

filter
    :: Finitary a
    => (a -> Bool)
    -> FinitarySet a
    -> FinitarySet a
filter :: forall a.
Finitary a =>
(a -> Bool) -> FinitarySet a -> FinitarySet a
filter a -> Bool
f (FinitarySet Vector (Cardinality a) Bit
xs) = Vector (Cardinality a) Bit -> FinitarySet a
forall a. Vector (Cardinality a) Bit -> FinitarySet a
FinitarySet (Vector (Cardinality a) Bit -> FinitarySet a)
-> Vector (Cardinality a) Bit -> FinitarySet a
forall a b. (a -> b) -> a -> b
$ (Finite (Cardinality a) -> Bit -> Bit)
-> Vector (Cardinality a) Bit -> Vector (Cardinality a) Bit
forall a b (n :: Nat).
(Unbox a, Unbox b) =>
(Finite n -> a -> b) -> Vector n a -> Vector n b
V.imap Finite (Cardinality a) -> Bit -> Bit
go Vector (Cardinality a) Bit
xs
  where
    go :: Finite (Cardinality a) -> Bit -> Bit
go Finite (Cardinality a)
i (Bit Bool
x) = Bool -> Bit
Bit (Bool -> Bit) -> Bool -> Bit
forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
&& a -> Bool
f (Finite (Cardinality a) -> a
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite Finite (Cardinality a)
i)
{-# INLINE filter #-}