module Ersatz.Counting where

import Ersatz.Bit
import Ersatz.Bits
import Ersatz.Codec
import Ersatz.Equatable
import Ersatz.Orderable

exactly :: Int -> [ Bit ] -> Bit
exactly :: Int -> [Bit] -> Bit
exactly Int
k [Bit]
bs = forall a. Codec a => Decoded a -> a
encode (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) forall t. Equatable t => t -> t -> Bit
=== forall (t :: * -> *). Foldable t => t Bit -> Bits
sumBit [Bit]
bs

atmost :: Int -> [ Bit ] -> Bit
atmost :: Int -> [Bit] -> Bit
atmost Int
k [Bit]
bs = forall a. Codec a => Decoded a -> a
encode (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) forall t. Orderable t => t -> t -> Bit
>=? forall (t :: * -> *) a. (Foldable t, HasBits a) => t a -> Bits
sumBits [Bit]
bs

atleast :: Int -> [ Bit ] -> Bit
atleast :: Int -> [Bit] -> Bit
atleast Int
k [Bit]
bs = forall a. Codec a => Decoded a -> a
encode (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) forall t. Orderable t => t -> t -> Bit
<=? forall (t :: * -> *) a. (Foldable t, HasBits a) => t a -> Bits
sumBits [Bit]
bs