packages feed

simple-enumeration 0.2.1 → 0.3

raw patch · 7 files changed

+986/−7 lines, 7 filesdep +contravariant

Dependencies added: contravariant

Files

ChangeLog.md view
@@ -1,5 +1,13 @@ # Changelog for enumeration +## 0.3 (22 April 2025)++- Fix `Enumeration.listOf empty` to return singleton list containing+  empty list instead of empty list (thanks to Koji Miyazato)+- New modules `Data.ProEnumeration` and `Data.CoEnumeration` (thanks+  to Koji Miyazato)+- Test up through GHC 9.12+ ## 0.2.1 (25 June 2020)  [Make `Data.Enumeration.Invertible.functionOf` a bit more permissive.](https://github.com/byorgey/enumeration/commit/59090f46ce01d7eda7371ba673fe54763b96c97e)
simple-enumeration.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           simple-enumeration-version:        0.2.1+version:        0.3 synopsis:       Finite or countably infinite sequences of values. description:    Finite or countably infinite sequences of values,                 supporting efficient indexing and random sampling.@@ -17,6 +17,7 @@ extra-source-files:     README.md     ChangeLog.md+tested-with: GHC ==9.4.8 || ==9.6.6 || ==9.8.4 || ==9.10.1 || ==9.12.1  source-repository head   type: git@@ -25,8 +26,10 @@ library   exposed-modules:      Data.Enumeration                         Data.Enumeration.Invertible+                        Data.CoEnumeration+                        Data.ProEnumeration   hs-source-dirs:       src-  build-depends:        base >=4.7 && <5, integer-gmp+  build-depends:        base >=4.7 && <5, integer-gmp, contravariant   default-language:     Haskell2010  test-suite doctests
+ src/Data/CoEnumeration.hs view
@@ -0,0 +1,439 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}++-- SPDX-License-Identifier: BSD-3-Clause++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.CoEnumeration+-- Copyright   :  Brent Yorgey, Koji Miyazato+-- Maintainer  :  byorgey@gmail.com+-- +-- A /coenumeration/ is a function from values to finite or countably infinite+-- sets, canonically represented by non-negative integers less than its cardinality.+-- +-- Alternatively, a coenumeration can be thought of as a classification of values+-- into finite or countably infinite classes, with each class labelled with+-- integers.+-- +-- This module provides many ways to construct @CoEnumeration@ values,+-- and most of them are implemented as inverses of enumerations made with+-- functions in "Data.Enumeration".+-- +-- == Example+-- +-- Through examples of this module, "Data.Enumeration" module is+-- referred by alias @E@.+-- +-- > import qualified Data.Enumeration as E+-- +-- >>> take 5 . drop 5 $ E.enumerate (E.listOf E.nat)+-- [[1,0],[2],[0,1],[1,0,0],[2,0]]+-- >>> locate (listOf nat) <$> [[1,0],[2],[0,1],[1,0,0],[2,0]]+-- [5,6,7,8,9]+--+-- >>> locate (listOf nat) [3,1,4,1,5,9,2]+-- 78651719792187121765701606023038613403478037124236785850350+-- >>> E.select (E.listOf E.nat) 78651719792187121765701606023038613403478037124236785850350+-- [3,1,4,1,5,9,2]+module Data.CoEnumeration+  ( -- * Coenumerations+    CoEnumeration(), card, locate, isFinite+  , unsafeMkCoEnumeration++    -- * Cardinality and Index+  , Index, Cardinality(..)++    -- * Primitive coenumerations+  , unit, lost+  , boundedEnum+  , nat+  , int+  , cw+  , rat++    -- * Coenumeration combinators+  , takeC, dropC, modulo, overlayC+  , infinite+  , (><), (<+>)+  , maybeOf, eitherOf, listOf, finiteSubsetOf+  , finiteFunctionOf++    -- * Utilities+  , unList, unSet+  ) where++import Data.Void+import Data.Bits+import Data.List (foldl')+import Data.Ratio++import Data.Functor.Contravariant+import Data.Functor.Contravariant.Divisible(lost, Divisible(..), Decidable(..))++import Data.Enumeration (Index, Cardinality(..))+import Data.Enumeration.Invertible (undiagonal)+++------------------------------------------------------------+-- Setup for doctest examples+------------------------------------------------------------++-- $setup+-- >>> :set -XTypeApplications+-- >>> import qualified Data.Enumeration as E++-- | A /coenumeration/ is a function from values to finite or countably infinite+-- sets, canonically represented by non-negative integers less than its cardinality.+-- +-- Alternatively, a coenumeration can be thought of as a classification of values+-- into finite or countably infinite classes, with each class labelled with+-- integers.+-- +-- 'CoEnumeration' is an instance of the following type classes:+--+-- * 'Contravariant' (you can change the type of base values contravariantly)+-- * 'Divisible' (representing Cartesian product of finite number of coenumerations)+--+--     * Binary cartesian product ('><')+--     * Coenumeration onto singleton set as an unit ('unit')+--+-- * 'Decidable' (representing disjoint union of finite number of coenumerations)+--+--     * Binary disjoint union ('<+>')+--     * Coenumeration of uninhabited type 'Void'. It's not exported directly,+--       but only through a method of the class+--       +--         'lose' @:: Decidable f => (a -> Void) -> f Void@+--       +--         or+--       +--         'lost' @:: Decidable f => f Void@.+data CoEnumeration a = CoEnumeration+  { -- | Get the cardinality of a coenumeration.+    --   Under \"classification\" interpretation,+    --   it is the cardinality of the set of classes.+    card :: Cardinality++    -- | Compute the index of a particular value.+  , locate :: a -> Index+  }++-- | Returns if the the cardinality of coenumeration is finite.+isFinite :: CoEnumeration a -> Bool+isFinite = (Infinite /=) . card++-- | Constructs a coenumeration.+--+--   To construct valid coenumeration by @unsafeMkCoEnumeration n f@,+--   for all @x :: a@, it must satisfy @(Finite (f x) < n)@.+--   +--   This functions does not (and never could) check the validity+--   of its arguments.+unsafeMkCoEnumeration :: Cardinality -> (a -> Index) -> CoEnumeration a+unsafeMkCoEnumeration = CoEnumeration++instance Contravariant CoEnumeration where+  contramap f e = e{ locate = locate e . f }++-- | Associativity of 'divide' is maintained only when+--   arguments are finite.+instance Divisible CoEnumeration where+  divide f a b = contramap f $ a >< b+  conquer = unit++-- | Associativity of 'choose' is maintained only when+--   arguments are finite.+instance Decidable CoEnumeration where+  choose f a b = contramap f $ a <+> b+  lose f = contramap f void++-- | Coenumeration to the singleton set.+--+-- >>> card unit+-- Finite 1+-- >>> locate unit True+-- 0+-- >>> locate unit (3 :: Int)+-- 0+-- >>> locate unit (cos :: Float -> Float)+-- 0+unit :: CoEnumeration a+unit = CoEnumeration{ card = 1, locate = const 0 }++-- | Coenumeration of an uninhabited type 'Void'.+--+-- >>> card void+-- Finite 0+-- +-- Note that when a coenumeration of a type @t@ has cardinality 0,+-- it should indicate /No/ value of @t@ can be created without+-- using bottoms like @undefined@.+void :: CoEnumeration Void+void = CoEnumeration{ card = 0, locate = const (error "locate void") }++-- | An inverse of forward 'E.boundedEnum'+boundedEnum :: forall a. (Enum a, Bounded a) => CoEnumeration a+boundedEnum = CoEnumeration{ card = size, locate = loc }+  where loc = toInteger . subtract lo . fromEnum+        lo = fromEnum (minBound @a)+        hi = fromEnum (maxBound @a)+        size = Finite $ 1 + toInteger hi - toInteger lo++-- | 'nat' is an inverse of forward enumeration 'E.nat'.+--  +-- For a negative integer @x@ which 'E.nat' doesn't enumerate,+-- @locate nat x@ returns the same index to the absolute value of @x@,+-- i.e. @locate nat x == locate nat (abs x)@.+-- +-- >>> locate nat <$> [-3 .. 3]+-- [3,2,1,0,1,2,3]+nat :: CoEnumeration Integer+nat = CoEnumeration{ card = Infinite, locate = abs }++-- | 'int' is the inverse of forward enumeration 'E.int', which is+--   all integers ordered as the sequence @0, 1, -1, 2, -2, ...@+-- +-- >>> locate int <$> [1, 2, 3, 4, 5]+-- [1,3,5,7,9]+-- >>> locate int <$> [0, -1 .. -5]+-- [0,2,4,6,8,10]+int :: CoEnumeration Integer+int = CoEnumeration{ card = Infinite, locate = integerToNat }+  where+    integerToNat :: Integer -> Integer+    integerToNat n+      | n <= 0    = 2 * negate n+      | otherwise = 2 * n - 1++-- | 'cw' is an inverse of forward enumeration 'E.cw'.+--+-- Because 'E.cw' only enumerates positive 'Rational' values,+-- @locate cw x@ for zero or less rational number @x@ could be arbitrary.+-- +-- This implementation chose @locate cw x = 33448095@ for all @x <= 0@, which is+-- the index of @765 % 4321@, rather than returning @undefined@.+-- +-- >>> locate cw <$> [1 % 1, 1 % 2, 2 % 1, 1 % 3, 3 % 2]+-- [0,1,2,3,4]+-- >>> locate cw (765 % 4321)+-- 33448095+-- >>> locate cw 0+-- 33448095+cw :: CoEnumeration Rational+cw = CoEnumeration{ card = Infinite, locate = locateCW }+  where+    locateCW x = case numerator x of+      n | n > 0     -> go n (denominator x) [] - 1+        | otherwise -> 33448095 {- Magic number, see the haddock above -}+    +    go 1 1 acc = foldl' (\i b -> 2 * i + b) 1 acc+    go a b acc+      | a > b = go (a - b) b (1 : acc)+      | a < b = go a (b - a) (0 : acc)+      | otherwise = error "cw: locateCW: Never reach here!"++-- | 'rat' is the inverse of forward enumeration 'E.rat'.+--+-- >>> let xs = E.enumerate . E.takeE 6 $ E.rat+-- >>> (xs, locate rat <$> xs)+-- ([0 % 1,1 % 1,(-1) % 1,1 % 2,(-1) % 2,2 % 1],[0,1,2,3,4,5])+-- >>> locate rat (E.select E.rat 1000)+-- 1000+rat :: CoEnumeration Rational+rat = contramap caseBySign $ maybeOf (cw <+> cw)+  where+    caseBySign :: Rational -> Maybe (Either Rational Rational)+    caseBySign x = case compare x 0 of+      LT -> Just (Right (negate x))+      EQ -> Nothing+      GT -> Just (Left x)++-- | Sets the cardinality of given coenumeration to 'Infinite'+infinite :: CoEnumeration a -> CoEnumeration a+infinite e = e{ card = Infinite }++-- | Cartesian product of coenumeration, made to be an inverse of+--   cartesian product of enumeration '(E.><)'.+--   +-- >>> let a  = E.finite 3 E.>< (E.boundedEnum @Bool)+-- >>> let a' = modulo 3     >< boundedEnum @Bool+-- >>> (E.enumerate a, locate a' <$> E.enumerate a)+-- ([(0,False),(0,True),(1,False),(1,True),(2,False),(2,True)],[0,1,2,3,4,5])+--+-- This operation is not associative if and only if one of arguments+-- is not finite.+(><) :: CoEnumeration a -> CoEnumeration b -> CoEnumeration (a,b)+e1 >< e2 = CoEnumeration{ card = n1 * n2, locate = locatePair }+  where+    n1 = card e1+    n2 = card e2+    locatePair = case (n1, n2) of+      (_,          Finite n2') -> \(a,b) -> locate e1 a * n2' + locate e2 b+      (Finite n1', Infinite)   -> \(a,b) -> locate e1 a + locate e2 b * n1'+      (Infinite,   Infinite)   -> \(a,b) -> undiagonal (locate e1 a, locate e2 b)++-- | Sum, or disjoint union, of two coenumerations.+--+--   It corresponds to disjoint union of enumerations 'E.eitherOf'.+--   +--   Its type can't be @CoEnumeration a -> CoEnumeration a -> CoEnumeration a@,+--   like 'Data.Enumeration.Enumeration' which is covariant functor,+--   because @CoEnumeration@ is 'Contravariant' functor.+--   +-- >>> let a  = E.finite 3 `E.eitherOf` (E.boundedEnum @Bool)+-- >>> let a' = modulo 3    <+>          boundedEnum @Bool+-- >>> (E.enumerate a, locate a' <$> E.enumerate a)+-- ([Left 0,Left 1,Left 2,Right False,Right True],[0,1,2,3,4])+--+-- This operation is not associative if and only if one of arguments+-- is not finite.+(<+>) :: CoEnumeration a -> CoEnumeration b -> CoEnumeration (Either a b)+e1 <+> e2 = CoEnumeration{ card = n1 + n2, locate = locateEither }+  where+    n1 = card e1+    n2 = card e2+    locateEither = case (n1, n2) of+      (Finite n1', _)          -> either (locate e1) ((n1' +) . locate e2)+      (Infinite,   Finite n2') -> either ((n2' +) . locate e1) (locate e2)+      (Infinite,   Infinite)   -> either ((*2) . locate e1) (succ . (*2) . locate e2)++-- |+--+-- >>> locate (dropC 3 nat) <$> [0..5]+-- [0,0,0,0,1,2]+dropC :: Integer -> CoEnumeration a -> CoEnumeration a+dropC k e+  | k == 0      = e+  | card e == 0 = e+  | card e <= Finite k = error "Impossible empty coenumeration"+  | otherwise = CoEnumeration{ card = size, locate = loc }+  where+    size = card e - Finite k+    loc = max 0 . subtract k . locate e++-- |+-- >>> locate (takeC 3 nat) <$> [0..5]+-- [0,1,2,2,2,2]+takeC :: Integer -> CoEnumeration a -> CoEnumeration a+takeC k+  | k <= 0 = checkEmpty+  | otherwise = aux+  where+    aux e =+      let size = min (Finite k) (card e)+          loc = min (k-1) . locate e+      in CoEnumeration{ card = size, locate = loc }++checkEmpty :: CoEnumeration a -> CoEnumeration a+checkEmpty e+  | card e == 0 = e+  | otherwise   = error "Impossible empty coenumeration"++-- |+-- >>> locate (modulo 3) <$> [0..7]+-- [0,1,2,0,1,2,0,1]+-- >>> locate (modulo 3) (-4)+-- 2+modulo :: Integer -> CoEnumeration Integer+modulo n+  | n <= 0    = error $ "modulo: invalid argument " ++ show n+  | otherwise = CoEnumeration{ card = Finite n, locate = (`mod` n) }++-- | @overlayC a b@ combines two coenumerations in parallel, sharing+--   indices of two coenumerations.+--+--   The resulting coenumeration has cardinality of the larger of the+--   two arguments.+overlayC :: CoEnumeration a -> CoEnumeration b -> CoEnumeration (Either a b)+overlayC e1 e2 = CoEnumeration{+    card = max (card e1) (card e2)+  , locate = either (locate e1) (locate e2)+  }++-- | The inverse of forward 'E.maybeOf'+maybeOf :: CoEnumeration a -> CoEnumeration (Maybe a)+maybeOf e = contramap (maybe (Left ()) Right) $ unit <+> e++-- | Synonym of '(<+>)'+eitherOf :: CoEnumeration a -> CoEnumeration b -> CoEnumeration (Either a b)+eitherOf = (<+>)++-- | Coenumerate all possible finite lists using given coenumeration.+--+--   If a coenumeration @a@ is the inverse of enumeration @b@,+--   'listOf' @a@ is the inverse of forward enumeration 'E.listOf' @b@.+-- +-- >>> E.enumerate . E.takeE 6 $ E.listOf E.nat+-- [[],[0],[0,0],[1],[0,0,0],[1,0]]+-- >>> locate (listOf nat) <$> [[],[0],[0,0],[1],[0,0,0],[1,0]]+-- [0,1,2,3,4,5]+-- >>> E.select (E.listOf E.nat) 1000000+-- [1008,26,0]+-- >>> locate (listOf nat) [1008,26,0]+-- 1000000+listOf :: CoEnumeration a -> CoEnumeration [a]+listOf e = CoEnumeration{ card = size, locate = locateList }+  where+    n = card e+    size | n == 0    = 1+         | otherwise = Infinite+    locateList = unList n . fmap (locate e)++unList :: Cardinality -> [Index] -> Index+unList (Finite k) = foldl' (\n a -> 1 + (a + n * k)) 0 . reverse+unList Infinite   = foldl' (\n a -> 1 + undiagonal (a, n)) 0 . reverse++-- | An inverse of 'E.finiteSubsetOf'.+--+--   Given a coenumeration of @a@, make a coenumeration of finite sets of+--   @a@, by ignoring order and repetition from @[a]@.+-- +-- >>> as = take 11 . E.enumerate $ E.finiteSubsetOf E.nat+-- >>> (as, locate (finiteSubsetOf nat) <$> as)+-- ([[],[0],[1],[0,1],[2],[0,2],[1,2],[0,1,2],[3],[0,3],[1,3]],[0,1,2,3,4,5,6,7,8,9,10])+finiteSubsetOf :: CoEnumeration a -> CoEnumeration [a]+finiteSubsetOf e = CoEnumeration{ card = size, locate = unSet . fmap (locate e) }+  where+    size = case card e of+      Finite k -> Finite (2 ^ k)+      Infinite -> Infinite++unSet :: [Index] -> Index+unSet = foldl' (\n i -> n .|. bit (fromInteger i)) 0++-- | An inverse of 'E.finiteEnumerationOf'.+--   +--   Given a coenumeration of @a@, make a coenumeration of function from+--   finite sets to @a@.+--   +--   Ideally, its type should be the following dependent type+--   +--   > {n :: Integer} -> CoEnumeration a -> CoEnumeration ({k :: Integer | k < n} -> a)+--+-- >>> let as = E.finiteEnumerationOf 3 (E.takeE 2 E.nat)+-- >>> map E.enumerate $ E.enumerate as+-- [[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]+-- >>> let inv_as = finiteFunctionOf 3 (takeC 2 nat)+-- >>> locate inv_as (E.select (E.finiteList [0,1,1]))+-- 3+finiteFunctionOf :: Integer -> CoEnumeration a -> CoEnumeration (Integer -> a)+finiteFunctionOf 0 _ = unit+finiteFunctionOf n a = CoEnumeration{ card = size, locate = locateEnum }+  where+    size = case card a of+      Finite k -> Finite (k^n)+      Infinite -> Infinite+    +    step = case card a of+      Finite k -> \r d -> k * r + d+      Infinite -> curry undiagonal++    locateEnum f =+      let go i !acc+            | i == n    = acc+            | otherwise = go (i+1) (step acc (locate a (f i)))+      in go 0 0
src/Data/Enumeration.hs view
@@ -667,9 +667,11 @@ -- -- >>> enumerate . takeE 15 $ listOf nat -- [[],[0],[0,0],[1],[0,0,0],[1,0],[2],[0,1],[1,0,0],[2,0],[3],[0,0,0,0],[1,1],[2,0,0],[3,0]]+-- >>> enumerate $ listOf empty :: [[Data.Void.Void]]+-- [[]] listOf :: Enumeration a -> Enumeration [a] listOf a = case card a of-  Finite 0 -> empty+  Finite 0 -> singleton []   _        -> listOfA     where       listOfA = infinite $ singleton [] <|> (:) <$> a <*> listOfA@@ -731,6 +733,22 @@  -- Implementation of `integerSqrt` taken from the Haskell wiki: -- https://wiki.haskell.org/Generic_number_type#squareRoot++-- | Find the square root (rounded down) of a positive integer.+--+-- >>> integerSqrt 0+-- 0+-- >>> integerSqrt 1+-- 1+-- >>> integerSqrt 3+-- 1+-- >>> integerSqrt 4+-- 2+-- >>> integerSqrt 38+-- 6+-- >>> integerSqrt 763686362402795580983595318628819602756+-- 27634875834763498734+ integerSqrt :: Integer -> Integer integerSqrt 0 = 0 integerSqrt 1 = 1@@ -739,9 +757,14 @@       (lowerRoot, lowerN) =         last $ takeWhile ((n>=) . snd) $ zip (1:twopows) twopows       newtonStep x = div (x + div n x) 2-      iters = iterate newtonStep (integerSqrt (div n lowerN ) * lowerRoot)       isRoot r = r^!2 <= n && n < (r+1)^!2-  in  head $ dropWhile (not . isRoot) iters+      initGuess = integerSqrt (div n lowerN ) * lowerRoot+  in  iterUntil isRoot newtonStep initGuess++iterUntil :: (a -> Bool) -> (a -> a) -> a -> a+iterUntil p f a+  | p a = a+  | otherwise = iterUntil p f (f a)  (^!) :: Num a => a -> Int -> a (^!) x n = x^n
src/Data/Enumeration/Invertible.hs view
@@ -94,6 +94,7 @@ -- $setup -- >>> :set -XTypeApplications -- >>> import Control.Arrow ((&&&))+-- >>> import Data.Maybe (fromMaybe, listToMaybe) -- >>> :{ --   data Tree = L | B Tree Tree deriving Show --   treesUpTo :: Int -> IEnumeration Tree@@ -469,7 +470,8 @@ -- >>> enumerate $ zipE nat (boundedEnum @Bool) -- [(0,False),(1,True)] ----- >>> cs = mapE (uncurry replicate) (length &&& head) (zipE (finiteList [1..10]) (dropE 35 (boundedEnum @Char)))+-- >>> headD x = fromMaybe x . listToMaybe+-- >>> cs = mapE (uncurry replicate) (length &&& headD ' ') (zipE (finiteList [1..10]) (dropE 35 (boundedEnum @Char))) -- >>> enumerate cs -- ["#","$$","%%%","&&&&","'''''","((((((",")))))))","********","+++++++++",",,,,,,,,,,"] -- >>> locate cs "********"
+ src/Data/ProEnumeration.hs view
@@ -0,0 +1,496 @@+{-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}++-- SPDX-License-Identifier: BSD-3-Clause++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.ProEnumeration+-- Copyright   :  Brent Yorgey, Koji Miyazato+-- Maintainer  :  byorgey@gmail.com+--+-- A /proenumeration/ is a pair of a 'CoEnumeration' and an 'Enumeration'+-- sharing the same cardinality.+--+-- A /proenumeration/ can be seen as a function with an explicitly enumerated+-- range.+--+-- Through documentations of this module, these import aliases are used:+--+-- > import qualified Data.Enumeration as E+-- > import qualified Data.CoEnumeration as C++-----------------------------------------------------------------------------++module Data.ProEnumeration(+  -- * Proenumeration type+    ProEnumeration()+  , card, select, locate++  , isFinite+  , baseEnum, baseCoEnum, run+  , enumerateRange++  , unsafeMkProEnumeration+  , mkProEnumeration++  -- * ProEnumeration is a Profunctor+  , dimap, (.@), (@.)++  -- * Using Cardinality+  , Cardinality(..), Index++  -- * Primitive proenumerations+  , unit, empty+  , singleton+  , modulo, clamped, boundsChecked+  , finiteList, finiteCycle+  , boundedEnum+  , nat, int, cw, rat++  -- * Combinators+  , infinite+  , compose+  , (><), (<+>)+  , maybeOf, eitherOf+  , listOf, finiteSubsetOf++  , enumerateP, coenumerateP+  , proenumerationOf+  , finiteFunctionOf+) where++import qualified Control.Applicative        as Ap (Alternative (empty))+import           Data.Void++import           Data.Functor.Contravariant++import           Data.CoEnumeration         (CoEnumeration)+import qualified Data.CoEnumeration         as C+import           Data.Enumeration           (Cardinality (..), Enumeration,+                                             Index)+import qualified Data.Enumeration           as E++-- | A /proenumeration/ is a pair of a 'CoEnumeration' and an 'Enumeration'+-- sharing the same cardinality.+-- Alternatively, a /proenumeration/ can be seen as a function with an+-- explicitly enumerated range.+--+-- Through this documentation,+-- proenumerations are shown in diagrams of the following shape:+--+-- >    f      g+-- > a ---> N ---> b  :: ProEnumeration a b+--+-- Which means it is a value @p :: ProEnumeration a b@ with+-- cardinality @N@, @locate p = f@, and @select p = g@.+--+-- We can see @N@ in the diagram as a subset of integers:+--+-- > N = {i :: Integer | i < N}+--+-- Then it is actually a (category-theoretic)+-- diagram showing values of @ProEnumeration a b@.+data ProEnumeration a b =+  ProEnumeration {+    -- | Get the cardinality of a proenumeration+    card   :: Cardinality++    -- | See @E.'E.select'@+  , select :: Index -> b++    -- | See @C.'C.locate'@+  , locate :: a -> Index+  }+  deriving (Functor)++-- | Returns if the the cardinality of a proenumeration is finite.+isFinite :: ProEnumeration a b -> Bool+isFinite = (/= Infinite) . card++-- | ProEnumeration is a Profunctor+--+-- > dimap l r p = l .@ p @. r+dimap :: (a' -> a) -> (b -> b') -> ProEnumeration a b -> ProEnumeration a' b'+dimap l r p = p{ select = r . select p, locate = locate p . l }++-- | > p @. r = dimap id r p+(@.) :: ProEnumeration a b -> (b -> b') -> ProEnumeration a b'+(@.) = flip fmap++infixl 7 @.++-- | > l .@ p = dimap l id p+(.@) :: (a' -> a) -> ProEnumeration a b -> ProEnumeration a' b+l .@ p = p{ locate = locate p . l }++infixr 8 .@++-- | Take an 'Enumeration' from a proenumeration,+--   discarding the @CoEnumeration@ part+baseEnum :: ProEnumeration a b -> Enumeration b+baseEnum p = E.mkEnumeration (card p) (select p)++-- | Take an 'CoEnumeration' from a proenumeration,+--   discarding @Enumeration@ part+baseCoEnum :: ProEnumeration a b -> CoEnumeration a+baseCoEnum p = C.unsafeMkCoEnumeration (card p) (locate p)++-- | Turn a proenumeration into a normal function.+--+-- > run p = (select p :: Index -> b) . (locate p :: a -> Index)+run :: ProEnumeration a b -> a -> b+run p = select p . locate p++-- * Primitive proenumerations++-- | @enumerateRange = E.enumerate . 'baseEnum'@+enumerateRange :: ProEnumeration a b -> [b]+enumerateRange = E.enumerate . baseEnum++-- | Constructs a proenumeration from a 'CoEnumeration' and an 'Enumeration'.+--+--   The cardinalities of the two arguments must be equal.+--   Otherwise, 'mkProEnumeration' returns an error.+--+--   > baseEnum (mkProEnumeration a b) = b+--   > baseCoEnum (mkProEnumeration a b) = a+--+-- >>> p = mkProEnumeration (C.modulo 3) (E.finiteList "abc")+-- >>> (card p, locate p 4, select p 1)+-- (Finite 3,1,'b')+mkProEnumeration :: CoEnumeration a -> Enumeration b -> ProEnumeration a b+mkProEnumeration a b+  | na == nb  = p+  | otherwise = error $ "mkProEnumeration cardinality mismatch:" ++ show (na, nb)+  where+    na = C.card a+    nb = E.card b+    p = ProEnumeration{ card = na, select = E.select b, locate = C.locate a }++-- | Constructs a proenumeration.+--+--   To construct a valid proenumeration by @unsafeMkProEnumeration n f g@,+--   it must satisfy the following conditions:+--+--   * For all @i :: Integer@, if @0 <= i && i < n@, then @f i@ should be+--     \"valid\" (usually, it means @f i@ should evaluate without exception).+--   * For all @x :: a@, @(Finite (g x) < n)@.+--+--   This functions does not (and never could) check the validity+--   of its arguments.+unsafeMkProEnumeration+  :: Cardinality-> (Index -> b) -> (a -> Index) -> ProEnumeration a b+unsafeMkProEnumeration = ProEnumeration++-- | @unit = 'mkProEnumeration' C.'C.unit' E.'E.unit'@+unit :: ProEnumeration a ()+unit = mkProEnumeration C.unit E.unit++-- | @singleton b = b <$ 'unit' = 'mkProEnumeration' C.'C.unit' (E.'E.singleton' b)@+singleton :: b -> ProEnumeration a b+singleton b = mkProEnumeration C.unit (E.singleton b)++-- | @empty = 'mkProEnumeration' 'lost' 'Ap.empty'@+empty :: ProEnumeration Void b+empty = mkProEnumeration C.lost Ap.empty++-- | @boundedEnum = 'mkProEnumeration' C.'C.boundedEnum' E.'E.boundedEnum'@+boundedEnum :: (Enum a, Bounded a) => ProEnumeration a a+boundedEnum = mkProEnumeration C.boundedEnum E.boundedEnum++-- | @modulo k = 'mkProEnumeration' (C.'C.modulo' k) (E.'E.finite' k)@+--+-- >>> card (modulo 13) == Finite 13+-- True+-- >>> run (modulo 13) 1462325 == 1462325 `mod` 13+-- True+modulo :: Integer -> ProEnumeration Integer Integer+modulo k = mkProEnumeration (C.modulo k) (E.finite k)++-- | @clamped lo hi@ is a proenumeration of integers,+--   which does not modify integers between @lo@ and @hi@, inclusive,+--   and limits smaller (larger) integer to @lo@ (@hi@).+--+--   It is an error to call this function if @lo > hi@.+--+--   > run (clamped lo hi) = min hi . max lo+--+-- >>> card (clamped (-2) 2)+-- Finite 5+-- >>> enumerateRange (clamped (-2) 2)+-- [-2,-1,0,1,2]+-- >>> run (clamped (-2) 2) <$> [-4 .. 4]+-- [-2,-2,-2,-1,0,1,2,2,2]+clamped :: Integer -> Integer -> ProEnumeration Integer Integer+clamped lo hi+  | lo <= hi = ProEnumeration+      { card = Finite (1 + hi - lo)+      , select = (+ lo)+      , locate = \i -> min (hi - lo) (max 0 (i - lo))+      }+  | otherwise = error "Empty range"++-- | @boundsChecked lo hi@ is a proenumeration of a \"bounds check\" function,+--   which validates that an input is between @lo@ and @hi@, inclusive,+--   and returns @Nothing@ if it is outside those bounds.+--+--   > run (boundsChecked lo hi) i+--       | lo <= i && i <= hi = Just i+--       | otherwise          = Nothing+--+-- >>> card (boundsChecked (-2) 2)+-- Finite 6+-- >>> -- Justs of [-2 .. 2] and Nothing+-- >>> enumerateRange (boundsChecked (-2) 2)+-- [Just (-2),Just (-1),Just 0,Just 1,Just 2,Nothing]+-- >>> run (boundsChecked (-2) 2) <$> [-4 .. 4]+-- [Nothing,Nothing,Just (-2),Just (-1),Just 0,Just 1,Just 2,Nothing,Nothing]+boundsChecked :: Integer -> Integer -> ProEnumeration Integer (Maybe Integer)+boundsChecked lo hi = ProEnumeration+  { card = Finite size+  , select = sel+  , locate = loc+  }+  where+    n = 1 + hi - lo+    size = 1 + max 0 n+    sel i+      | 0 <= i && i < n = Just (i + lo)+      | i == n          = Nothing+      | otherwise = error "out of bounds"+    loc k | lo <= k && k <= hi = k - lo+          | otherwise          = n+++-- | @finiteList as@ is a proenumeration of a \"bounds checked\"+--   indexing of @as@.+--+--   > run (finiteList as) i+--       | 0 <= i && i < length as = Just (as !! i)+--       | otherwise               = Nothing+--+--   Note that 'finiteList' uses '!!' on the input list+--   under the hood, which has bad performance for long lists.+--   See also the documentation of Data.Enumeration.'E.finiteList'.+-- >>> card (finiteList "HELLO")+-- Finite 6+-- >>> -- Justs and Nothing+-- >>> enumerateRange (finiteList "HELLO")+-- [Just 'H',Just 'E',Just 'L',Just 'L',Just 'O',Nothing]+-- >>> run (finiteList "HELLO") <$> [0 .. 6]+-- [Just 'H',Just 'E',Just 'L',Just 'L',Just 'O',Nothing,Nothing]+finiteList :: [a] -> ProEnumeration Integer (Maybe a)+finiteList as = boundsChecked 0 (n-1) @. (fmap sel)+  where+    as' = E.finiteList as+    Finite n = E.card as'+    sel = E.select as'++-- | @finiteCycle as@ is a proenumeration of an indexing of @as@,+--   where every integer is a valid index by taking it modulo @length as@.+--+--   > run (finiteCycle as) i = as !! (i `mod` length as)+--+--   If @as@ is an empty list, it is an error.+--+-- >>> card (finiteCycle "HELLO")+-- Finite 5+-- >>> enumerateRange (finiteCycle "HELLO")+-- "HELLO"+-- >>> run (finiteCycle "HELLO") <$> [0 .. 10]+-- "HELLOHELLOH"+finiteCycle :: [a] -> ProEnumeration Integer a+finiteCycle as = modulo n @. sel+  where+    as' = E.finiteList as+    Finite n = E.card as'+    sel = E.select as'++-- | @nat = 'mkProEnumeration' C.'C.nat' E.'E.nat'@+nat :: ProEnumeration Integer Integer+nat = mkProEnumeration C.nat E.nat++-- | @int = 'mkProEnumeration' C.'C.int' E.'E.int'@+int :: ProEnumeration Integer Integer+int = mkProEnumeration C.int E.int++-- | @cw = 'mkProEnumeration' C.'C.cw' E.'E.cw'@+cw :: ProEnumeration Rational Rational+cw = mkProEnumeration C.cw E.cw++-- | @rat = 'mkProEnumeration' C.'C.rat' E.'E.rat'@+rat :: ProEnumeration Rational Rational+rat = mkProEnumeration C.rat E.rat++-- | Sets the cardinality of given proenumeration to 'Infinite'+infinite :: ProEnumeration a b -> ProEnumeration a b+infinite p = p{ card = Infinite }++-- * Proenumeration combinators++-- | From two proenumerations @p, q@, we can make a proenumeration+--   @compose p q@ which behaves as a composed function+--   (in diagrammatic order like 'Control.Category.>>>'.)+--+--   > run (compose p q) = run q . run p+--+--   @p@ and @q@ can be drawn in a diagram as follows:+--+--   > [_______p______] [______q______]+--   >+--   >    lp      sp      lq      sq+--   > a ----> N ----> b ----> M ----> c+--+--   To get a proenumeration @a -> ?? -> c@, there are two obvious choices:+--+--   >       run p >>> lq         sq+--   > a --------------------> M ----> c+--   >    lp         sp >>> run q+--   > a ----> N --------------------> c+--+--   This function chooses the option with the smaller cardinality.+compose :: ProEnumeration a b -> ProEnumeration b c -> ProEnumeration a c+compose p q+  | card p <= card q = p @. run q+  | otherwise        = run p .@ q++-- | Cartesian product of proenumerations.+--+-- @+-- p >< q = 'mkProEnumeration' (baseCoEnum p C.'C.><' baseCoEnum q)+--                             (baseEnum p   E.'E.><' baseEnum q)+-- @+--+-- This operation is not associative if and only if one of the arguments+-- is not finite.+(><) :: ProEnumeration a1 b1 -> ProEnumeration a2 b2 -> ProEnumeration (a1,a2) (b1,b2)+p >< q = mkProEnumeration (baseCoEnum p C.>< baseCoEnum q) (baseEnum p E.>< baseEnum q)++-- | Disjoint sum of proenumerations.+--+-- @+-- p <+> q = 'mkProEnumeration'+--    (baseCoEnum p C.'C.<+>'        baseCoEnum q)+--    (baseEnum p   `E.'E.eitherOf'` baseEnum q)+-- @+-- This operation is not associative if and only if one of the arguments+-- is not finite.+(<+>) :: ProEnumeration a1 b1 -> ProEnumeration a2 b2+      -> ProEnumeration (Either a1 a2) (Either b1 b2)+p <+> q = mkProEnumeration (baseCoEnum p C.<+> baseCoEnum q) (E.eitherOf (baseEnum p) (baseEnum q))++-- | @maybeOf p = 'mkProEnumeration' (C.'C.maybeOf' (baseCoEnum p)) (E.'E.maybeOf' (baseEnum p))@+maybeOf :: ProEnumeration a b -> ProEnumeration (Maybe a) (Maybe b)+maybeOf p = dimap (maybe (Left ()) Right) (either (const Nothing) Just) $+              unit <+> p++-- | Synonym of '(<+>)'+eitherOf :: ProEnumeration a1 b1 -> ProEnumeration a2 b2+         -> ProEnumeration (Either a1 a2) (Either b1 b2)+eitherOf = (<+>)++-- | @listOf p = 'mkProEnumeration' (C.'C.listOf' (baseCoEnum p)) (E.'E.listOf' (baseEnum p))@+listOf :: ProEnumeration a b -> ProEnumeration [a] [b]+listOf p = mkProEnumeration (C.listOf (baseCoEnum p)) (E.listOf (baseEnum p))++-- |+-- @+-- finiteSubsetOf p = 'mkProEnumeration'+--     (C.'C.finiteSubsetOf' (baseCoEnum p))+--     (E.'E.finiteSubsetOf' (baseEnum p))+-- @+finiteSubsetOf :: ProEnumeration a b -> ProEnumeration [a] [b]+finiteSubsetOf p =+  mkProEnumeration (C.finiteSubsetOf (baseCoEnum p)) (E.finiteSubsetOf (baseEnum p))++-- | Enumerate every possible proenumeration.+--+-- @enumerateP a b@ generates proenumerations @p@+-- such that the function @run p@ has the following properties:+--+-- * The range of @run p@ is a subset of @b :: Enumeration b@.+-- * If @locate a x = locate a y@, then @run p x = run p y@.+--   In other words, @run p@ factors through @locate a@.+--+-- This function generates proenumerations @p@ in such a way that+-- every function of type @a -> b@ with the above properties uniquely+-- appears as @run p@ for some enumerated @p@.+enumerateP :: CoEnumeration a -> Enumeration b -> Enumeration (ProEnumeration a b)+enumerateP a b = case (C.card a, E.card b) of+  (0, _) -> E.singleton (mkProEnumeration a Ap.empty)+  (_, 1) -> E.singleton (mkProEnumeration C.unit b)+  (Finite k,_) -> mkProEnumeration a <$> E.finiteEnumerationOf (fromInteger k) b+  (Infinite,_) -> error "infinite domain"++-- | Coenumerate every possible function.+--+-- @coenumerateP as bs@ classifies functions of type @a -> b@+-- by the following criterion:+--+-- @f@ and @g@ have the same index+--+-- /if and only if/+--+-- For all elements @a@ of @as :: Enumeration a@,+--   @locate bs (f a) = locate bs (g a)@.+--+-- /Note/: The suffix @P@ suggests it coenumerates @ProEnumeration a b@,+-- but it actually coenumerates @a -> b@.  The reason is that+-- @ProEnumeration a b@ carries extra data and constraints like its cardinality,+-- but the classification does not care about those. Thus, it is more permissive to+-- accept any function of type @a -> b@.+--+-- To force it to coenumerate proenumerations,+-- @'contramap' 'run'@ can be applied.+coenumerateP :: Enumeration a -> CoEnumeration b -> CoEnumeration (a -> b)+coenumerateP a b = case (E.card a, C.card b) of+  (0, _)       -> C.unit+  (_, 1)       -> C.unit+  (Finite k,_) -> contramap (\f -> f . E.select a) $ C.finiteFunctionOf k b+  (Infinite,_) -> error "infinite domain"++{- | 'enumerateP' and 'coenumerateP' combined.++>    l_a      s_a+> a -----> N -----> a'  :: ProEnumeration a a'+>+>    l_b      s_b+> b -----> M -----> b'  :: ProEnumeration b b'+>+>+> (N -> b) ---> (N -> M) ---> (N -> b')+>    ^             ||             |+>    | (. s_a)     ||             | (. l_a)+>    |             ||             v+> (a' -> b)      (M ^ N)       (a -> b')++* When @N@ is finite, @(M ^ N)@ is at most countable, since @M@ is+  at most countable.++* The enumerated functions (of type @a -> b'@) are compositions+  of @l_a :: a -> N@ and functions of type @N -> b@.+  It is beneficial to tell this fact by the type,+  which happens to be @ProEnumeration a b'@.++-}+proenumerationOf+  :: ProEnumeration a a'+  -> ProEnumeration b b'+  -> ProEnumeration (a' -> b) (ProEnumeration a b')+proenumerationOf a b+  = mkProEnumeration+      (coenumerateP (baseEnum a) (baseCoEnum b))+      (enumerateP (baseCoEnum a) (baseEnum b))++-- | @finiteFunctionOf k p@ is a proenumeration of products of @k@ copies of+--   @a@ and @b@ respectively.+--+--   If @p@ is a invertible enumeration, @finiteFunctionOf k p@ is too.+--+--   It is implemented using 'proenumerationOf'.+finiteFunctionOf+  :: Integer -> ProEnumeration a b -> ProEnumeration (Integer -> a) (Integer -> b)+finiteFunctionOf k p = proenumerationOf (modulo k) p @. select
test/doctests.hs view
@@ -1,2 +1,10 @@ import           Test.DocTest-main = doctest ["-isrc", "src/Data/Enumeration.hs", "src/Data/Enumeration/Invertible.hs"]+main = doctest+  ["-isrc"+  ,"src/Data/Enumeration.hs"+  ,"src/Data/Enumeration/Invertible.hs"+  ,"src/Data/CoEnumeration.hs"+  ,"src/Data/ProEnumeration.hs"+  ,"--fast"+  ,"-package contravariant"+  ]