simple-enumeration 0.1 → 0.2
raw patch · 5 files changed
+765/−26 lines, 5 filesdep +integer-gmp
Dependencies added: integer-gmp
Files
- ChangeLog.md +4/−0
- simple-enumeration.cabal +3/−2
- src/Data/Enumeration.hs +89/−23
- src/Data/Enumeration/Invertible.hs +668/−0
- test/doctests.hs +1/−1
ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for enumeration +## 0.2 (3 July 2019)++Added `Data.Enumeration.Invertible`.+ ## 0.1 (14 May 2019) Initial release.
simple-enumeration.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.12 name: simple-enumeration-version: 0.1+version: 0.2 synopsis: Finite or countably infinite sequences of values. description: Finite or countably infinite sequences of values, supporting efficient indexing and random sampling.@@ -24,8 +24,9 @@ library exposed-modules: Data.Enumeration+ Data.Enumeration.Invertible hs-source-dirs: src- build-depends: base >=4.7 && <5+ build-depends: base >=4.7 && <5, integer-gmp default-language: Haskell2010 test-suite doctests
src/Data/Enumeration.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -47,6 +48,9 @@ -- >>> select trees 12345 -- B (B (B (B L (B L L)) L) (B L (B (B L L) L))) (B (B L (B L L)) (B (B L L) (B L (B L L)))) --+-- For /invertible/ enumerations, /i.e./ bijections between some set+-- of values and natural numbers (or finite prefix thereof), see+-- "Data.Enumeration.Invertible". ----------------------------------------------------------------------------- @@ -54,6 +58,7 @@ ( -- * Enumerations Enumeration+ , mkEnumeration -- ** Using enumerations @@ -90,6 +95,8 @@ , maybeOf , eitherOf , listOf+ , finiteSubsetOf+ , finiteEnumerationOf -- * Utilities @@ -99,9 +106,13 @@ import Control.Applicative +import Data.Bits ((.&.)) import Data.Ratio-import Data.Tuple (swap)+import Data.Tuple (swap) +import GHC.Base (Int (I#))+import GHC.Integer.Logarithms (integerLog2#)+ ------------------------------------------------------------ -- Setup for doctest examples ------------------------------------------------------------@@ -188,6 +199,11 @@ } deriving Functor +-- | Create an enumeration primitively out of a cardinality and an+-- index function.+mkEnumeration :: Cardinality -> (Index -> a) -> Enumeration a+mkEnumeration = Enumeration+ -- | The @Applicative@ instance for @Enumeration@ works similarly to -- the instance for lists: @pure = singleton@, and @f '<*>' x@ takes -- the Cartesian product of @f@ and @x@ (see ('><')) and applies@@ -221,9 +237,10 @@ -- | List the elements of an enumeration in order. Inverse of -- 'finiteList'. enumerate :: Enumeration a -> [a]-enumerate e = case card e of- Infinite -> map (select e) [0 ..]- Finite c -> map (select e) [0 .. c-1]+enumerate e = map (select e) $+ case card e of+ Infinite -> [0 ..]+ Finite c -> [0 .. c-1] ------------------------------------------------------------ -- Constructing Enumerations@@ -248,8 +265,8 @@ -- [()] unit :: Enumeration () unit = Enumeration- { card = 1- , select = \case { 0 -> (); i -> error $ "select unit " ++ show i }+ { card = 1+ , select = const () } -- | An enumeration of a single given element.@@ -431,7 +448,7 @@ -- trees = infinite $ singleton L '<|>' B '<$>' trees '<*>' trees -- @ ----- Trying to use @treeBad@ at all will simply hang, since trying to+-- Trying to use @treesBad@ at all will simply hang, since trying to -- compute its cardinality leads to infinite recursion. -- -- @@@ -439,7 +456,7 @@ -- ^CInterrupted. -- @ ----- However, using 'infinite', as in the definition of 'trees',+-- However, using 'infinite', as in the definition of @trees@, -- provides the needed laziness: -- -- >>> card trees@@ -477,15 +494,14 @@ -- If you want to interleave an infinite enumeration of finite -- enumerations, you are out of luck. interleave :: Enumeration (Enumeration a) -> Enumeration a-interleave e = case card e of- Finite n -> Enumeration- { card = Infinite- , select = \k -> let (i,j) = k `divMod` n in select (select e j) i- }- Infinite -> Enumeration- { card = Infinite- , select = \k -> let (i,j) = diagonal k in select (select e j) i- }+interleave e = Enumeration+ { card = Infinite+ , select = \k ->+ let (i,j) = case card e of+ Finite n -> k `divMod` n+ Infinite -> diagonal k+ in select (select e j) i+ } -- | Zip two enumerations in parallel, producing the pair of -- elements at each index. The resulting enumeration is truncated@@ -637,7 +653,7 @@ -- >>> enumerate $ maybeOf (finiteList [1,2,3]) -- [Nothing,Just 1,Just 2,Just 3] maybeOf :: Enumeration a -> Enumeration (Maybe a)-maybeOf e = singleton Nothing <|> Just <$> e+maybeOf a = singleton Nothing <|> Just <$> a -- | Enumerae all possible values of type @Either a b@ with inner values -- taken from the given enumerations.@@ -645,19 +661,69 @@ -- >>> enumerate . takeE 6 $ eitherOf nat nat -- [Left 0,Right 0,Left 1,Right 1,Left 2,Right 2] eitherOf :: Enumeration a -> Enumeration b -> Enumeration (Either a b)-eitherOf e1 e2 = Left <$> e1 <|> Right <$> e2+eitherOf a b = Left <$> a <|> Right <$> b --- | Enumerate all possible lists containing values from the given enumeration.+-- | Enumerate all possible finite lists containing values from the given enumeration. -- -- >>> 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]] listOf :: Enumeration a -> Enumeration [a]-listOf e = case card e of+listOf a = case card a of Finite 0 -> empty- _ -> listOfE+ _ -> listOfA where- listOfE = infinite $ singleton [] <|> (:) <$> e <*> listOfE+ listOfA = infinite $ singleton [] <|> (:) <$> a <*> listOfA +-- | Enumerate all possible finite subsets of values from the given enumeration.+--+-- >>> enumerate $ finiteSubsetOf (finite 3)+-- [[],[0],[1],[0,1],[2],[0,2],[1,2],[0,1,2]]+finiteSubsetOf :: Enumeration a -> Enumeration [a]+finiteSubsetOf as = pick <$> bitstrings+ where+ bitstrings = case card as of+ Infinite -> nat+ Finite k -> finite (2^k)++ pick 0 = []+ pick n = select as (integerLog2 l) : pick (n - l)+ where+ l = lsb n++ lsb :: Integer -> Integer+ lsb n = n .&. (-n)++ integerLog2 :: Integer -> Integer+ integerLog2 n = fromIntegral (I# (integerLog2# n))++-- | @finiteEnumerationOf n a@ creates an enumeration of all sequences+-- of exactly n items taken from the enumeration @a@.+finiteEnumerationOf :: Int -> Enumeration a -> Enumeration (Enumeration a)+finiteEnumerationOf 0 _ = singleton empty+finiteEnumerationOf n a = case card a of+ Finite k -> selectEnum k <$> finite (k^n)+ Infinite -> foldr cons (singleton empty) (replicate n a)++ where+ selectEnum k = fmap (select a) . finiteList . reverse . take n . toBase k++ toBase _ 0 = repeat 0+ toBase k n = n `mod` k : toBase k (n `div` k)++ cons :: Enumeration a -> Enumeration (Enumeration a) -> Enumeration (Enumeration a)+ cons a as = (<|>) <$> (singleton <$> a) <*> as++-- https://mail.haskell.org/pipermail/haskell-cafe/2008-February/039465.html+-- imLog :: Integer->Integer->Integer+-- > > imLog b x+-- > > = if x < b then+-- > > 0+-- > > else+-- > > let+-- > > l = 2 * imLog (b*b) x+-- > > doDiv x l = if x < b then l else doDiv (x`div`b) (l+1)+-- > > in+-- > > doDiv (x`div`(b^l)) l -- Note: more efficient integerSqrt in arithmoi -- (Math.NumberTheory.Powers.Squares), but it's a rather heavyweight
+ src/Data/Enumeration/Invertible.hs view
@@ -0,0 +1,668 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- SPDX-License-Identifier: BSD-3-Clause++-----------------------------------------------------------------------------+-- |+-- Module : Data.Enumeration.Invertible+-- Copyright : Brent Yorgey+-- Maintainer : byorgey@gmail.com+--+-- An /invertible enumeration/ is a bijection between a set of values+-- and the natural numbers (or a finite prefix thereof), represented+-- as a pair of inverse functions, one in each direction. Hence they+-- support efficient indexing and can be constructed for very large+-- finite sets. A few examples are shown below.+--+-- Compared to "Data.Enumeration", one can also build invertible+-- enumerations of functions (or other type formers with contravariant+-- arguments); however, invertible enumerations no longer make for+-- valid 'Functor', 'Applicative', or 'Alternative' instances.+--+-- This module exports many of the same names as "Data.Enumeration";+-- the expectation is that you will choose one or the other to import,+-- though of course it is possible to import both if you qualify the+-- imports.+--+-----------------------------------------------------------------------------++module Data.Enumeration.Invertible+ ( -- * Invertible enumerations++ IEnumeration++ -- ** Using enumerations++ , Cardinality(..), card+ , Index, select, locate++ , isFinite+ , enumerate++ -- ** Primitive enumerations++ , void+ , unit+ , singleton+ , finite+ , finiteList+ , boundedEnum++ , nat+ , int+ , cw+ , rat++ -- ** Enumeration combinators++ , mapE+ , takeE, dropE+ , zipE+ , infinite+ , (<+>)+ , (><)+ , interleave++ , maybeOf+ , eitherOf+ , listOf+ , finiteSubsetOf+ , finiteEnumerationOf+ , functionOf++ -- * Utilities++ , undiagonal+ ) where++import Control.Applicative (Alternative (..))+import Data.Bits (shiftL, (.|.))+import Data.List (findIndex, foldl')+import Data.Maybe (fromJust)+import Data.Ratio++import Data.Enumeration (Cardinality (..), Enumeration, Index)+import qualified Data.Enumeration as E++------------------------------------------------------------+-- Setup for doctest examples+------------------------------------------------------------++-- $setup+-- >>> :set -XTypeApplications+-- >>> import Control.Arrow ((&&&))+-- >>> :{+-- data Tree = L | B Tree Tree deriving Show+-- treesUpTo :: Int -> IEnumeration Tree+-- treesUpTo 0 = singleton L+-- treesUpTo n = mapE toTree fromTree (unit <+> (t' >< t'))+-- where+-- t' = treesUpTo (n-1)+-- trees :: IEnumeration Tree+-- trees = infinite $ mapE toTree fromTree (unit <+> (trees >< trees))+-- toTree :: Either () (Tree, Tree) -> Tree+-- toTree = either (const L) (uncurry B)+-- fromTree :: Tree -> Either () (Tree, Tree)+-- fromTree L = Left ()+-- fromTree (B l r) = Right (l,r)+-- :}++------------------------------------------------------------+-- Invertible enumerations+------------------------------------------------------------++-- | An invertible enumeration is a bijection between a set of+-- enumerated values and the natural numbers, or a finite prefix of+-- the natural numbers. An invertible enumeration is represented as+-- a function from natural numbers to values, paired with an inverse+-- function that returns the natural number index of a given value.+-- Enumerations can thus easily be constructed for very large sets,+-- and support efficient indexing and random sampling.+--+-- Note that 'IEnumeration' cannot be made an instance of 'Functor',+-- 'Applicative', or 'Alternative'. However, it does support the+-- 'functionOf' combinator which cannot be supported by+-- "Data.Enumeration".++data IEnumeration a = IEnumeration+ { baseEnum :: Enumeration a+ -- | Compute the index of a particular value in its enumeration.+ -- Note that the result of 'locate' is only valid when given a+ -- value which is actually in the range of the enumeration.+ , locate :: a -> Index+ }++-- | Map a pair of inverse functions over an invertible enumeration of+-- @a@ values to turn it into an invertible enumeration of @b@+-- values. Because invertible enumerations contain a /bijection/ to+-- the natural numbers, we really do need both directions of a+-- bijection between @a@ and @b@ in order to map. This is why+-- 'IEnumeration' cannot be an instance of 'Functor'.+mapE :: (a -> b) -> (b -> a) -> IEnumeration a -> IEnumeration b+mapE f g (IEnumeration e l) = IEnumeration (f <$> e) (l . g)++------------------------------------------------------------+-- Using enumerations+------------------------------------------------------------++-- | Select the value at a particular index. Precondition: the index+-- must be strictly less than the cardinality.+select :: IEnumeration a -> (Index -> a)+select = E.select . baseEnum++-- | Get the cardinality of an enumeration.+card :: IEnumeration a -> Cardinality+card = E.card . baseEnum++-- | Test whether an enumeration is finite.+--+-- >>> isFinite (finiteList [1,2,3])+-- True+--+-- >>> isFinite nat+-- False+isFinite :: IEnumeration a -> Bool+isFinite (IEnumeration e _) = E.isFinite e++-- | List the elements of an enumeration in order. Inverse of+-- 'finiteList'.+enumerate :: IEnumeration a -> [a]+enumerate e = case card e of+ Infinite -> map (select e) [0 ..]+ Finite c -> map (select e) [0 .. c-1]++------------------------------------------------------------+-- Constructing Enumerations+------------------------------------------------------------++-- | The empty enumeration, with cardinality zero and no elements.+--+-- >>> card void+-- Finite 0+--+-- >>> enumerate void+-- []+void :: IEnumeration a+void = IEnumeration empty (error "locate void")++-- | The unit enumeration, with a single value of @()@ at index 0.+--+-- >>> card unit+-- Finite 1+--+-- >>> enumerate unit+-- [()]+--+-- >>> locate unit ()+-- 0+unit :: IEnumeration ()+unit = IEnumeration E.unit (const 0)++-- | An enumeration of a single given element at index 0.+--+-- >>> card (singleton 17)+-- Finite 1+--+-- >>> enumerate (singleton 17)+-- [17]+--+-- >>> locate (singleton 17) 17+-- 0+singleton :: a -> IEnumeration a+singleton a = IEnumeration (E.singleton a) (const 0)++-- | A finite prefix of the natural numbers.+--+-- >>> card (finite 5)+-- Finite 5+-- >>> card (finite 1234567890987654321)+-- Finite 1234567890987654321+--+-- >>> enumerate (finite 5)+-- [0,1,2,3,4]+-- >>> enumerate (finite 0)+-- []+--+-- >>> locate (finite 5) 2+-- 2+finite :: Integer -> IEnumeration Integer+finite n = IEnumeration (E.finite n) id++-- | Construct an enumeration from the elements of a /finite/ list.+-- The elements of the list must all be distinct. To turn an+-- enumeration back into a list, use 'enumerate'.+--+-- >>> enumerate (finiteList [2,3,8,1])+-- [2,3,8,1]+-- >>> select (finiteList [2,3,8,1]) 2+-- 8+-- >>> locate (finiteList [2,3,8,1]) 8+-- 2+--+-- 'finiteList' does not work on infinite lists: inspecting the+-- cardinality of the resulting enumeration (something many of the+-- enumeration combinators need to do) will hang trying to compute+-- the length of the infinite list.+--+-- 'finiteList' uses ('!!') and 'findIndex' internally (which both+-- take $O(n)$ time), so you probably want to avoid using it on long+-- lists. It would be possible to make a version with better+-- indexing performance by allocating a vector internally, but I am+-- too lazy to do it. If you have a good use case let me know+-- (better yet, submit a pull request).+finiteList :: Eq a => [a] -> IEnumeration a+finiteList as = IEnumeration (E.finiteList as) locateFinite+ -- Note the use of !! and findIndex is not very efficient, but for+ -- small lists it probably still beats the overhead of allocating a+ -- vector. Most likely this will only ever be used with very small+ -- lists anyway. If it becomes a problem we could add another+ -- combinator that behaves just like finiteList but allocates a+ -- Vector internally.++ where+ locateFinite a = fromIntegral . fromJust $ findIndex (==a) as++-- | Enumerate all the values of a bounded 'Enum' instance.+--+-- >>> enumerate (boundedEnum @Bool)+-- [False,True]+--+-- >>> select (boundedEnum @Char) 97+-- 'a'+-- >>> locate (boundedEnum @Char) 'Z'+-- 90+--+-- >>> card (boundedEnum @Int)+-- Finite 18446744073709551616+-- >>> select (boundedEnum @Int) 0+-- -9223372036854775808+boundedEnum :: forall a. (Enum a, Bounded a) => IEnumeration a+boundedEnum = IEnumeration E.boundedEnum (subtract lo . fromIntegral . fromEnum)+ where+ lo :: Index+ lo = fromIntegral (fromEnum (minBound @a))++-- | The natural numbers, @0, 1, 2, ...@.+--+-- >>> enumerate . takeE 10 $ nat+-- [0,1,2,3,4,5,6,7,8,9]+nat :: IEnumeration Integer+nat = IEnumeration E.nat id++-- | All integers in the order @0, 1, -1, 2, -2, 3, -3, ...@.+int :: IEnumeration Integer+int = IEnumeration E.int locateInt+ where+ locateInt z+ | z <= 0 = 2 * abs z+ | otherwise = 2*z - 1++-- | The positive rational numbers, enumerated according to the+-- [Calkin-Wilf sequence](http://www.cs.ox.ac.uk/publications/publication1664-abstract.html).+--+-- >>> enumerate . takeE 10 $ cw+-- [1 % 1,1 % 2,2 % 1,1 % 3,3 % 2,2 % 3,3 % 1,1 % 4,4 % 3,3 % 5]+-- >>> locate cw (3 % 2)+-- 4+-- >>> locate cw (23 % 99)+-- 3183+cw :: IEnumeration Rational+cw = IEnumeration E.cw (pred . locateCW)+ where+ locateCW r = go (numerator r, denominator r)+ go (1,1) = 1+ go (a,b)+ | a < b = 2 * go (a, b - a)+ | otherwise = 1 + 2 * go (a - b, b)++-- | An enumeration of all rational numbers: 0 first, then each+-- rational in the Calkin-Wilf sequence followed by its negative.+--+-- >>> enumerate . takeE 10 $ rat+-- [0 % 1,1 % 1,(-1) % 1,1 % 2,(-1) % 2,2 % 1,(-2) % 1,1 % 3,(-1) % 3,3 % 2]+-- >>> locate rat (-45 % 61)+-- 2540++rat :: IEnumeration Rational+rat = mapE+ (either (const 0) (either id negate))+ unrat+ (unit <+> (cw <+> cw))+ where+ unrat 0 = Left ()+ unrat r+ | r > 0 = Right (Left r)+ | otherwise = Right (Right (-r))++-- | Take a finite prefix from the beginning of an enumeration. @takeE+-- k e@ always yields the empty enumeration for \(k \leq 0\), and+-- results in @e@ whenever @k@ is greater than or equal to the+-- cardinality of the enumeration. Otherwise @takeE k e@ has+-- cardinality @k@ and matches @e@ from @0@ to @k-1@.+--+-- >>> enumerate $ takeE 3 (boundedEnum @Int)+-- [-9223372036854775808,-9223372036854775807,-9223372036854775806]+--+-- >>> enumerate $ takeE 2 (finiteList [1..5])+-- [1,2]+--+-- >>> enumerate $ takeE 0 (finiteList [1..5])+-- []+--+-- >>> enumerate $ takeE 7 (finiteList [1..5])+-- [1,2,3,4,5]+takeE :: Integer -> IEnumeration a -> IEnumeration a+takeE k (IEnumeration e l) = IEnumeration (E.takeE k e) l++-- | Drop some elements from the beginning of an enumeration. @dropE k+-- e@ yields @e@ unchanged if \(k \leq 0\), and results in the empty+-- enumeration whenever @k@ is greater than or equal to the+-- cardinality of @e@.+--+-- >>> enumerate $ dropE 2 (finiteList [1..5])+-- [3,4,5]+--+-- >>> enumerate $ dropE 0 (finiteList [1..5])+-- [1,2,3,4,5]+--+-- >>> enumerate $ dropE 7 (finiteList [1..5])+-- []+dropE :: Integer -> IEnumeration a -> IEnumeration a+dropE k (IEnumeration e l) = IEnumeration (E.dropE k e) (subtract (max 0 k) . l)++-- | Explicitly mark an enumeration as having an infinite cardinality,+-- ignoring the previous cardinality. It is sometimes necessary to+-- use this as a "hint" when constructing a recursive enumeration+-- whose cardinality would otherwise consist of an infinite sum of+-- finite cardinalities.+--+-- For example, consider the following definitions:+--+-- @+-- data Tree = L | B Tree Tree deriving Show+--+-- toTree :: Either () (Tree, Tree) -> Tree+-- toTree = either (const L) (uncurry B)+--+-- fromTree :: Tree -> Either () (Tree, Tree)+-- fromTree L = Left ()+-- fromTree (B l r) = Right (l,r)+--+-- treesBad :: IEnumeration Tree+-- treesBad = mapE toTree fromTree (unit '<+>' (treesBad '><' treesBad))+--+-- trees :: IEnumeration Tree+-- trees = infinite $ mapE toTree fromTree (unit '<+>' (trees '><' trees))+-- @+--+-- Trying to use @treesBad@ at all will simply hang, since trying to+-- compute its cardinality leads to infinite recursion.+--+-- @+-- \>>>\ select treesBad 5+-- ^CInterrupted.+-- @+--+-- However, using 'infinite', as in the definition of @trees@,+-- provides the needed laziness:+--+-- >>> card trees+-- Infinite+-- >>> enumerate . takeE 3 $ trees+-- [L,B L L,B L (B L L)]+-- >>> select trees 87239862967296+-- B (B (B (B (B L L) (B (B (B L L) L) L)) (B L (B L (B L L)))) (B (B (B L (B L (B L L))) (B (B L L) (B L L))) (B (B L (B L (B L L))) L))) (B (B L (B (B (B L (B L L)) (B L L)) L)) (B (B (B L (B L L)) L) L))+-- >>> select trees 123+-- B (B L (B L L)) (B (B L (B L L)) (B L (B L L)))+-- >>> locate trees (B (B L (B L L)) (B (B L (B L L)) (B L (B L L))))+-- 123++infinite :: IEnumeration a -> IEnumeration a+infinite (IEnumeration e l) = IEnumeration (E.infinite e) l++-- | Fairly interleave a set of /infinite/ enumerations.+--+-- For a finite set of infinite enumerations, a round-robin+-- interleaving is used. That is, if we think of an enumeration of+-- enumerations as a 2D matrix read off row-by-row, this corresponds+-- to taking the transpose of a matrix with finitely many infinite+-- rows, turning it into one with infinitely many finite rows. For+-- an infinite set of infinite enumerations, /i.e./ an infinite 2D+-- matrix, the resulting enumeration reads off the matrix by+-- 'Data.Enumeration.diagonal's.+--+-- Note that the type of this function is slightly different than+-- its counterpart in "Data.Enumeration": each enumerated value in+-- the output is tagged with an index indicating which input+-- enumeration it came from. This is required to make the result+-- invertible, and is analogous to the way the output values of+-- '<+>' are tagged with 'Left' or 'Right'; in fact, 'interleave'+-- can be thought of as an iterated version of '<+>', but with a+-- more efficient implementation.++interleave :: IEnumeration (IEnumeration a) -> IEnumeration (Index, a)+interleave e = IEnumeration+ { baseEnum = E.mkEnumeration Infinite $ \k ->+ let (i,j) = case card e of+ Finite n -> k `divMod` n+ Infinite -> E.diagonal k+ in (j, select (select e j) i)+ , locate = \(j, a) ->+ let i = locate (select e j) a+ in case card e of+ Finite n -> i*n + j+ Infinite -> undiagonal (i,j)+ }++-- | Zip two enumerations in parallel, producing the pair of+-- elements at each index. The resulting enumeration is truncated+-- to the cardinality of the smaller of the two arguments.+--+-- Note that defining @zipWithE@ as in "Data.Enumeration" is not+-- possible since there would be no way to invert it in general.+-- However, one can use 'zipE' in combination with 'mapE' to achieve+-- a similar result.+--+-- >>> enumerate $ zipE nat (boundedEnum @Bool)+-- [(0,False),(1,True)]+--+-- >>> cs = mapE (uncurry replicate) (length &&& head) (zipE (finiteList [1..10]) (dropE 35 (boundedEnum @Char)))+-- >>> enumerate cs+-- ["#","$$","%%%","&&&&","'''''","((((((",")))))))","********","+++++++++",",,,,,,,,,,"]+-- >>> locate cs "********"+-- 7++zipE :: IEnumeration a -> IEnumeration b -> IEnumeration (a,b)+zipE ea eb = IEnumeration+ { baseEnum = E.zipE (baseEnum ea) (baseEnum eb)+ , locate = locate ea . fst+ }++-- | Sum, /i.e./ disjoint union, of two enumerations. If both are+-- finite, all the values of the first will be enumerated before the+-- values of the second. If only one is finite, the values from the+-- finite enumeration will be listed first. If both are infinite, a+-- fair (alternating) interleaving is used, so that every value ends+-- up at a finite index in the result.+--+-- Note that this has a different type than the version in+-- "Data.Enumeration". Here we require the output to carry an+-- explicit 'Either' tag to make it invertible.+--+-- >>> enumerate . takeE 5 $ singleton 17 <+> nat+-- [Left 17,Right 0,Right 1,Right 2,Right 3]+--+-- >>> enumerate . takeE 5 $ nat <+> singleton 17+-- [Right 17,Left 0,Left 1,Left 2,Left 3]+--+-- >>> enumerate . takeE 5 $ nat <+> nat+-- [Left 0,Right 0,Left 1,Right 1,Left 2]+--+-- >>> locate (nat <+> nat) (Right 35)+-- 71++(<+>) :: IEnumeration a -> IEnumeration b -> IEnumeration (Either a b)+a <+> b = IEnumeration (Left <$> baseEnum a <|> Right <$> baseEnum b) (locateEither a b)+ where+ locateEither :: IEnumeration a -> IEnumeration b -> (Either a b -> Index)+ locateEither a b = case (card a, card b) of+ (Finite k1, _) -> either (locate a) ((+k1) . locate b)+ (_, Finite k2) -> either ((+k2) . locate a) (locate b)+ _ -> either ((*2) . locate a) (succ . (*2) . locate b)+++-- | The other half of the isomorphism between \(\mathbb{N}\) and+-- \(\mathbb{N} \times \mathbb{N}\) which enumerates by diagonals:+-- turn a pair of natural numbers giving a position in the 2D grid+-- into the number in the cell, according to this numbering scheme:+--+-- @+-- 0 1 3 6 ...+-- 2 4 7+-- 5 8+-- 9+-- @+undiagonal :: (Integer, Integer) -> Integer+undiagonal (r,c) = (r+c) * (r+c+1) `div` 2 + r++-- | Cartesian product of enumerations. If both are finite, uses a+-- simple lexicographic ordering. If only one is finite, the+-- resulting enumeration is still in lexicographic order, with the+-- infinite enumeration as the most significant component. For two+-- infinite enumerations, uses a fair 'Data.Enumeration.diagonal' interleaving.+--+-- >>> enumerate $ finiteList [1..3] >< finiteList "abcd"+-- [(1,'a'),(1,'b'),(1,'c'),(1,'d'),(2,'a'),(2,'b'),(2,'c'),(2,'d'),(3,'a'),(3,'b'),(3,'c'),(3,'d')]+--+-- >>> enumerate . takeE 10 $ finiteList "abc" >< nat+-- [('a',0),('b',0),('c',0),('a',1),('b',1),('c',1),('a',2),('b',2),('c',2),('a',3)]+--+-- >>> enumerate . takeE 10 $ nat >< finiteList "abc"+-- [(0,'a'),(0,'b'),(0,'c'),(1,'a'),(1,'b'),(1,'c'),(2,'a'),(2,'b'),(2,'c'),(3,'a')]+--+-- >>> enumerate . takeE 10 $ nat >< nat+-- [(0,0),(0,1),(1,0),(0,2),(1,1),(2,0),(0,3),(1,2),(2,1),(3,0)]+--+-- >>> locate (nat >< nat) (1,1)+-- 4+-- >>> locate (nat >< nat) (36,45)+-- 3357+--+-- Like ('<+>'), this operation is also not associative (not even up+-- to reassociating tuples).+(><) :: IEnumeration a -> IEnumeration b -> IEnumeration (a,b)+a >< b = IEnumeration (baseEnum a E.>< baseEnum b) (locatePair a b)+ where+ locatePair :: IEnumeration a -> IEnumeration b -> ((a,b) -> Index)+ locatePair a b = case (card a, card b) of+ (_, Finite k2) -> \(x,y) -> k2 * locate a x + locate b y+ (Finite k1, _) -> \(x,y) -> k1 * locate b y + locate a x+ _ -> \(x,y) -> undiagonal (locate a x, locate b y)++------------------------------------------------------------+-- Building standard data types+------------------------------------------------------------++-- | Enumerate all possible values of type `Maybe a`, where the values+-- of type `a` are taken from the given enumeration.+--+-- >>> enumerate $ maybeOf (finiteList [1,2,3])+-- [Nothing,Just 1,Just 2,Just 3]+-- >>> locate (maybeOf (maybeOf (finiteList [1,2,3]))) (Just (Just 2))+-- 3+maybeOf :: IEnumeration a -> IEnumeration (Maybe a)+maybeOf a = mapE (either (const Nothing) Just) (maybe (Left ()) Right) (unit <+> a)++-- | Enumerae all possible values of type @Either a b@ with inner values+-- taken from the given enumerations.+--+-- Note that for invertible enumerations, 'eitherOf' is simply a+-- synonym for '<+>'.+--+-- >>> enumerate . takeE 6 $ eitherOf nat nat+-- [Left 0,Right 0,Left 1,Right 1,Left 2,Right 2]+eitherOf :: IEnumeration a -> IEnumeration b -> IEnumeration (Either a b)+eitherOf = (<+>)++-- | Enumerate all possible finite lists containing values from the+-- given enumeration.+--+-- >>> 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]]+-- >>> locate (listOf nat) [3,4,20,5,19]+-- 666270815854068922513792635440014+listOf :: IEnumeration a -> IEnumeration [a]+listOf a = case card a of+ Finite 0 -> singleton []+ _ -> listOfA+ where+ listOfA = infinite $+ mapE (either (const []) (uncurry (:))) uncons (unit <+> (a >< listOfA))+ uncons [] = Left ()+ uncons (a:as) = Right (a, as)++-- | Enumerate all possible finite subsets of values from the given+-- enumeration. The elements in each list will always occur in+-- increasing order of their index in the given enumeration.+--+-- >>> enumerate $ finiteSubsetOf (finite 3)+-- [[],[0],[1],[0,1],[2],[0,2],[1,2],[0,1,2]]+--+-- >>> locate (finiteSubsetOf nat) [2,3,6,8]+-- 332+-- >>> 332 == 2^8 + 2^6 + 2^3 + 2^2+-- True+finiteSubsetOf :: IEnumeration a -> IEnumeration [a]+finiteSubsetOf a = IEnumeration (E.finiteSubsetOf (baseEnum a)) unpick+ where+ unpick = foldl' (.|.) 0 . map ((1 `shiftL`) . fromIntegral . locate a)++-- | @finiteEnumerationOf n a@ creates an enumeration of all sequences+-- of exactly n items taken from the enumeration @a@.+--+-- >>> map E.enumerate . enumerate $ finiteEnumerationOf 2 (finite 3)+-- [[0,0],[0,1],[0,2],[1,0],[1,1],[1,2],[2,0],[2,1],[2,2]]+--+-- >>> map E.enumerate . take 10 . enumerate $ finiteEnumerationOf 3 nat+-- [[0,0,0],[0,0,1],[1,0,0],[0,1,0],[1,0,1],[2,0,0],[0,0,2],[1,1,0],[2,0,1],[3,0,0]]+finiteEnumerationOf :: Int -> IEnumeration a -> IEnumeration (Enumeration a)+finiteEnumerationOf 0 _ = singleton empty+finiteEnumerationOf n a = case card a of+ Finite k -> IEnumeration (E.finiteEnumerationOf n (baseEnum a)) (locateEnum k)+ Infinite -> foldr prod (singleton empty) (replicate n a)++ where+ locateEnum k = fromBase k . reverse . E.enumerate . fmap (locate a)++ fromBase k = foldr (\d r -> d + k*r) 0++ prod :: IEnumeration a -> IEnumeration (Enumeration a) -> IEnumeration (Enumeration a)+ prod a as = mapE (\(a,e) -> E.singleton a <|> e) (\e -> (E.select e 0, E.dropE 1 e))+ (a >< as)++-- | @functionOf a b@ creates an enumeration of all functions taking+-- values from the enumeration @a@ and returning values from the+-- enumeration @b@. As a precondition, @a@ must be finite;+-- otherwise @functionOf@ throws an error.+--+-- >>> bbs = functionOf (boundedEnum @Bool) (boundedEnum @Bool)+-- >>> card bbs+-- Finite 4+-- >>> map (select bbs 2) [False, True]+-- [True,False]+-- >>> locate bbs not+-- 2+--+-- >>> locate (functionOf bbs (boundedEnum @Bool)) (\f -> f True)+-- 5+functionOf :: IEnumeration a -> IEnumeration b -> IEnumeration (a -> b)+functionOf as bs = case card as of+ Infinite -> error "functionOf with infinite domain"+ Finite n -> mapE toFunc fromFunc (finiteEnumerationOf (fromIntegral n) bs)++ where+ toFunc bTuple a = E.select bTuple (locate as a)+ fromFunc f = f <$> baseEnum as
test/doctests.hs view
@@ -1,2 +1,2 @@ import Test.DocTest-main = doctest ["-isrc", "src/Data/Enumeration.hs"]+main = doctest ["-isrc", "src/Data/Enumeration.hs", "src/Data/Enumeration/Invertible.hs"]