> {-# OPTIONS_HADDOCK show-extensions #-}
> {-# Language
>   CPP,
>   FlexibleInstances,
>   FunctionalDependencies,
>   MultiParamTypeClasses,
>   Trustworthy
>   #-}

#if !defined(MIN_VERSION_base)
# define MIN_VERSION_base(a,b,c) 0
#endif
#if !defined(MIN_VERSION_containers)
# define MIN_VERSION_containers(a,b,c) 0
#endif

> {-|
> Module      : LTK.Containers
> Copyright   : (c) 2016-2021 Dakotah Lambert
> License     : MIT
> 
> Containers: a uniform way to work with entities that may
> contain other entities.
> -}
> module LTK.Containers
>        ( Container(..)
>        , Linearizable(..)
>        , chooseOne
>        , discardOne
>        , Collapsible(..)
>        , isize
>        , zsize
>        , fromCollapsible
>        -- *Combining multiple Containers
>        , unionAll
>        , intersectAll
>        , interleave
>        -- *Generic versions of Prelude functions and similar
>        , anyS
>        , allS
>        , both
>        , tmap
>        , keep
>        , groupBy
>        , partitionBy
>        , refinePartitionBy
>        -- *Multisets
>        , Multiset
>        , multiplicity
>        , multiplicities
>        , multisetFromList
>        , setFromMultiset
>        -- *Set of Set with alternate ordering
>        -- |The 'choose' instance for 'Set' will always pick
>        -- the least available element.
>        -- If one wants to process elements
>        -- in a different order,
>        -- one can simply wrap the elements in such a way
>        -- that they sort in the intended order of processing.
>        -- This section contains some such wrapper types.
>        , IncreasingSize(..)
>        , DecreasingSize(..)
>        -- *Miscellaneous classes
>        , HasAlphabet(..)
>        -- *Miscellaneous functions
>        , extractMonotonic
>        , sequencesOver
>        , tr
>        ) where

#if !MIN_VERSION_base(4,8,0)
> import safe Data.Monoid (Monoid, mempty, mappend)
#endif
#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
> import safe Data.Semigroup (Semigroup, (<>))
#endif
#endif
> import safe Data.Set (Set)
> import safe qualified Data.Set as Set

In mathematics, we typically use the same symbols to denote similar
operations on objects with similar structure.  For example, both
numbers and matrices can be multiplied, even though what constitutes
multiplication differs between them.  In this module, a few classes
are defined to allow such polymorphism.

> -- |The 'Container' class is used for types that can contain objects
> -- and can be combined with 'union', 'intersection', and 'difference'
> -- (relative complement).  Instances of 'Container' should satisfy the
> -- following laws:
> --
> -- > isIn == flip contains
> -- > isNotIn == flip doesNotContain
> -- > doesNotContain a == not . contains a
> -- > contains a empty == False
> -- > contains a (singleton b) == (a == b)
> -- > contains a (insert b c) == (a == b) || contains a c
> -- > contains a (union c1 c2) == contains a c1 || contains a c2
> -- > contains a (intersection c1 c2) == contains a c1 && contains a c2
> -- > intersection c c == c
> -- > difference c c == empty
> class Container c a | c -> a
>     where isIn :: Eq a => c -> a -> Bool
>           isNotIn :: Eq a => c -> a -> Bool
>           contains :: Eq a => a -> c -> Bool
>           doesNotContain :: Eq a => a -> c -> Bool
>           isEmpty :: c -> Bool
>           -- |@(union a b)@ returns a collection of elements that
>           -- are in one of @a@ or @b@, or both.
>           union :: c -> c -> c
>           -- |@(intersection a b)@ returns a collection of elements
>           -- that are in both @a@ and @b@.
>           intersection :: Eq a => c -> c -> c
>           -- |@(difference a b)@ returns a collection of elements
>           -- that are in @a@ but not in @b@.
>           difference :: Eq a => c -> c -> c
>           -- |@(symmetricDifference a b)@ returns a collection of
>           -- elements that are in one of @a@ or @b@, but not both.
>           symmetricDifference :: Eq a => c -> c -> c
>           empty :: c
>           insert :: a -> c -> c
>           singleton :: a -> c
>           -- |@(isSubsetOf y x)@ tells if @x@ is a subset of @y@.
>           isSubsetOf :: Eq a => c -> c -> Bool
>           -- |@(isSupersetOf y x)@ tells if @x@ is a superset of @y@.
>           isSupersetOf :: Eq a => c -> c -> Bool
>           -- |@(isProperSubsetOf y x)@ tells whether
>           -- @x@ is a proper subset of @y@.
>           isProperSubsetOf :: Eq a => c -> c -> Bool
>           -- |@(isProperSupersetOf y x)@ tells whether
>           -- @x@ is a proper superset of @y@.
>           isProperSupersetOf :: Eq a => c -> c -> Bool
>           -- Default definitions:
>           isIn = (a -> c -> Bool) -> c -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> c -> Bool
forall c a. (Container c a, Eq a) => a -> c -> Bool
contains
>           isNotIn c
c = Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> a -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn c
c
>           contains = (c -> a -> Bool) -> a -> c -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip c -> a -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn
>           doesNotContain = (c -> a -> Bool) -> a -> c -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip c -> a -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isNotIn
>           insert a
a c
c = c -> c -> c
forall c a. Container c a => c -> c -> c
union (a -> c
forall c a. Container c a => a -> c
singleton a
a) c
c
>           singleton a
a = a -> c -> c
forall c a. Container c a => a -> c -> c
insert a
a c
forall c a. Container c a => c
empty
>           symmetricDifference c
a c
b
>               = c -> c -> c
forall c a. Container c a => c -> c -> c
union (c -> c -> c
forall c a. (Container c a, Eq a) => c -> c -> c
difference c
a c
b) (c -> c -> c
forall c a. (Container c a, Eq a) => c -> c -> c
difference c
b c
a)
>           isSubsetOf c
a c
b = c -> Bool
forall c a. Container c a => c -> Bool
isEmpty (c -> c -> c
forall c a. (Container c a, Eq a) => c -> c -> c
difference c
b c
a)
>           isSupersetOf = (c -> c -> Bool) -> c -> c -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip c -> c -> Bool
forall c a. (Container c a, Eq a) => c -> c -> Bool
isSubsetOf
>           isProperSubsetOf c
a c
b = c -> c -> Bool
forall c a. (Container c a, Eq a) => c -> c -> Bool
isSubsetOf c
a c
b
>                                  Bool -> Bool -> Bool
&& Bool -> Bool
not (c -> Bool
forall c a. Container c a => c -> Bool
isEmpty (c -> c -> c
forall c a. (Container c a, Eq a) => c -> c -> c
difference c
b c
a))
>           isProperSupersetOf = (c -> c -> Bool) -> c -> c -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip c -> c -> Bool
forall c a. (Container c a, Eq a) => c -> c -> Bool
isProperSubsetOf
>           {-# MINIMAL
>               (contains | isIn)
>             , union
>             , intersection
>             , difference
>             , empty
>             , isEmpty
>             , (insert | singleton) #-}

The `Linearizable` class is used for types that can be traversed
linearly in one direction.  The class provides a function `choose`
where for any linearizable structure `ls`, `choose ls` returns as
a pair both a single element contained in `ls` and another structure
containing all and only those elements of `ls` that were not chosen.
The first and second parts of this pair may be returned alone by
`chooseOne` or `discardOne`, respectively.

> -- |The 'Linearizable' class is used for types that can be
> -- traversed linearly in one direction.
> class Linearizable l
>     where choose :: l a -> (a, l a)
>           -- ^Return the next element and
>           -- the collection of remaining elements.

> -- |Like 'choose', but discards the remaining elements.
> chooseOne :: (Linearizable l) => l a -> a
> chooseOne :: l a -> a
chooseOne   = (a, l a) -> a
forall a b. (a, b) -> a
fst ((a, l a) -> a) -> (l a -> (a, l a)) -> l a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l a -> (a, l a)
forall (l :: * -> *) a. Linearizable l => l a -> (a, l a)
choose
> -- |Like 'choose', but discards the next element.
> discardOne :: (Linearizable l) => l a -> l a
> discardOne :: l a -> l a
discardOne  = (a, l a) -> l a
forall a b. (a, b) -> b
snd ((a, l a) -> l a) -> (l a -> (a, l a)) -> l a -> l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l a -> (a, l a)
forall (l :: * -> *) a. Linearizable l => l a -> (a, l a)
choose

> -- |Combine two linearizable containers such that the elements
> -- of the first and second are inserted in an interleaving manner.
> -- For lists, this guarantees that a finite initial segment will
> -- contain elements from each, in contrast to the @(++)@ operator.
> --
> -- @since 0.3
> interleave :: (Linearizable c, Container (c a) a)
>               => c a -> c a -> c a
> interleave :: c a -> c a -> c a
interleave c a
xs c a
ys
>     | c a -> Bool
forall c a. Container c a => c -> Bool
isEmpty c a
xs = c a
ys
>     | c a -> Bool
forall c a. Container c a => c -> Bool
isEmpty c a
ys = c a
xs
>     | Bool
otherwise  = let (a
a, c a
as) = c a -> (a, c a)
forall (l :: * -> *) a. Linearizable l => l a -> (a, l a)
choose c a
xs
>                        (a
b, c a
bs) = c a -> (a, c a)
forall (l :: * -> *) a. Linearizable l => l a -> (a, l a)
choose c a
ys
>                    in a -> c a -> c a
forall c a. Container c a => a -> c -> c
insert a
a (c a -> c a) -> (c a -> c a) -> c a -> c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> c a -> c a
forall c a. Container c a => a -> c -> c
insert a
b (c a -> c a) -> c a -> c a
forall a b. (a -> b) -> a -> b
$ c a -> c a -> c a
forall (c :: * -> *) a.
(Linearizable c, Container (c a) a) =>
c a -> c a -> c a
interleave c a
as c a
bs

> -- |The 'Collapsible' class is used for types that can be collapsed
> -- to a single value, like a fold over a list.  Any structure \(c\)
> -- that is 'Collapsible' must necessarily be 'Linearizable', since:
> --
> -- > collapse (:) [] c
> --
> -- performs a linearization.
> class Linearizable c => Collapsible c
>     where collapse :: (a -> b -> b) -> b -> c a -> b
>           size :: (Integral a) => c b -> a

>           collapse a -> b -> b
f = ((b, c a) -> b) -> b -> c a -> b
forall a b c. ((a, b) -> c) -> a -> b -> c
curry ((b, c a) -> b
forall a b. (a, b) -> a
fst ((b, c a) -> b) -> ((b, c a) -> (b, c a)) -> (b, c a) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, c a) -> Bool)
-> ((b, c a) -> (b, c a)) -> (b, c a) -> (b, c a)
forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (Integer -> Bool) -> ((b, c a) -> Integer) -> (b, c a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c a -> Integer
forall (c :: * -> *) b. Collapsible c => c b -> Integer
isize (c a -> Integer) -> ((b, c a) -> c a) -> (b, c a) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, c a) -> c a
forall a b. (a, b) -> b
snd) (b, c a) -> (b, c a)
forall (l :: * -> *). Linearizable l => (b, l a) -> (b, l a)
cont)
>               where cont :: (b, l a) -> (b, l a)
cont (b
a, l a
bs) = let (a
x, l a
xs) = l a -> (a, l a)
forall (l :: * -> *) a. Linearizable l => l a -> (a, l a)
choose l a
bs
>                                    in (a -> b -> b
f a
x b
a, l a
xs)
>           size = (b -> a -> a) -> a -> c b -> a
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse ((a -> a) -> b -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. Enum a => a -> a
succ) a
0
>           {-# MINIMAL collapse | size #-}

> -- |Analogue to @isEmpty@ for Collapsible structures
> zsize :: Collapsible c => c b -> Bool
> zsize :: c b -> Bool
zsize = (b -> Bool -> Bool) -> Bool -> c b -> Bool
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse ((Bool -> Bool) -> b -> Bool -> Bool
forall a b. a -> b -> a
const ((Bool -> Bool) -> b -> Bool -> Bool)
-> (Bool -> Bool) -> b -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
False) Bool
True
> {-# INLINE[1] zsize #-}
> {-# RULES
> "zsize/Set" zsize = Set.null
>   #-}

> -- |The size of the input as an integer
> isize :: Collapsible c => c b -> Integer
> isize :: c b -> Integer
isize = c b -> Integer
forall (c :: * -> *) a b. (Collapsible c, Integral a) => c b -> a
size


Consequences
============

A collapsible structure of containers may be merged into a single
container with either unions or intersections:

> -- |Combine 'Container's with 'union'.
> unionAll :: (Container c a, Collapsible s) => s c -> c
> unionAll :: s c -> c
unionAll = (c -> c -> c) -> c -> s c -> c
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse c -> c -> c
forall c a. Container c a => c -> c -> c
union c
forall c a. Container c a => c
empty

> -- |Combine 'Container's with 'intersection'.
> -- An empty source yields an empty result.
> intersectAll :: (Container c a, Eq a, Collapsible s) => s c -> c
> intersectAll :: s c -> c
intersectAll s c
xs
>     | s c -> Bool
forall (c :: * -> *) b. Collapsible c => c b -> Bool
zsize s c
xs  = c
forall c a. Container c a => c
empty
>     | Bool
otherwise = (c -> c -> c) -> c -> s c -> c
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse c -> c -> c
forall c a. (Container c a, Eq a) => c -> c -> c
intersection c
x s c
xs'
>     where (c
x, s c
xs') = s c -> (c, s c)
forall (l :: * -> *) a. Linearizable l => l a -> (a, l a)
choose s c
xs

It is nice to have tests for existential and universal satisfaction
of predicates:

> -- |True iff some element satisfies a predicate.
> anyS :: Collapsible s => (a -> Bool) -> s a -> Bool
> anyS :: (a -> Bool) -> s a -> Bool
anyS a -> Bool
f = (a -> Bool -> Bool) -> Bool -> s a -> Bool
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> (a -> Bool) -> a -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
f) Bool
False
> {-# INLINE[1] anyS #-}
> {-# RULES
> "anyS/[]" forall (a :: [x]) f.
>     anyS f a = any f a
>   #-}

> -- |True iff all elements satisfy a predicate.
> allS :: Collapsible s => (a -> Bool) -> s a -> Bool
> allS :: (a -> Bool) -> s a -> Bool
allS a -> Bool
f = (a -> Bool -> Bool) -> Bool -> s a -> Bool
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (a -> Bool) -> a -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
f) Bool
True
> {-# INLINE[1] allS #-}
> {-# RULES
> "allS/[]" forall (a :: [x]) f.
>     allS f a = all f a
>   #-}

> -- |True iff the given object satisfies both given predicates.
> --
> -- @since 0.3
> both :: (a -> Bool) -> (a -> Bool) -> a -> Bool
> both :: (a -> Bool) -> (a -> Bool) -> a -> Bool
both a -> Bool
f a -> Bool
g a
x = a -> Bool
f a
x Bool -> Bool -> Bool
&& a -> Bool
g a
x

If something is a `Collapsible` `Container`, then we can use
properties of each typeclass to build map and filter, here called
`tmap` and `keep` to avoid namespace collisions.

> -- |Appy a function to each element of a 'Collapsible'.
> tmap :: (Collapsible s, Container (s b1) b) => (a -> b) -> s a -> s b1
> tmap :: (a -> b) -> s a -> s b1
tmap a -> b
f s a
xs = (a -> s b1 -> s b1) -> s b1 -> s a -> s b1
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (b -> s b1 -> s b1
forall c a. Container c a => a -> c -> c
insert (b -> s b1 -> s b1) -> (a -> b) -> a -> s b1 -> s b1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) s b1
forall c a. Container c a => c
empty s a
xs
> {-# INLINE[1] tmap #-}
> {-# RULES
> "tmap/[]"  tmap = map
> "tmap/Set" forall (x :: Ord a => Set a) (f :: Ord b => a -> b) .
>        tmap f x = Set.map f x
>   #-}

> -- |Retain only those elements that satisfy a predicate.
> keep :: (Collapsible s, Container (s a) a) => (a -> Bool) -> s a -> s a
> keep :: (a -> Bool) -> s a -> s a
keep a -> Bool
f s a
xs = (a -> s a -> s a) -> s a -> s a -> s a
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse a -> s a -> s a
forall p. Container p a => a -> p -> p
maybeKeep s a
forall c a. Container c a => c
empty s a
xs
>     where maybeKeep :: a -> p -> p
maybeKeep a
a p
as
>               | a -> Bool
f a
a        = a -> p -> p
forall c a. Container c a => a -> c -> c
insert a
a p
as
>               | Bool
otherwise  = p
as
> {-# INLINE[1] keep #-}
> {-# RULES
> "keep/[]" keep = filter
> "keep/Set" keep = Set.filter
> "keep/compose" forall (f :: a -> Bool) (g :: a -> Bool) xs.
>       keep f (keep g xs) = keep (\x -> f x && g x) xs
>   #-}

> -- |Partition a Container.  For example,
> --
> -- > groupBy (`mod` 3) [0..9] == [[0,3,6,9],[1,4,7],[2,5,8]]
> groupBy :: ( Eq b, Collapsible s, Container (s a) a
>            , Container (s (s a)) (s a) ) =>
>            (a -> b) -> s a -> s (s a)
> groupBy :: (a -> b) -> s a -> s (s a)
groupBy a -> b
f s a
xs
>     | s a -> Bool
forall c a. Container c a => c -> Bool
isEmpty s a
xs  =  s (s a)
forall c a. Container c a => c
empty
>     | Bool
otherwise   =  s a -> s (s a) -> s (s a)
forall c a. Container c a => a -> c -> c
insert s a
currentGroup (s (s a) -> s (s a)) -> s (s a) -> s (s a)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> s a -> s (s a)
forall b (s :: * -> *) a.
(Eq b, Collapsible s, Container (s a) a,
 Container (s (s a)) (s a)) =>
(a -> b) -> s a -> s (s a)
groupBy a -> b
f s a
others
>     where y :: b
y = a -> b
f (s a -> a
forall (l :: * -> *) a. Linearizable l => l a -> a
chooseOne s a
xs)
>           (s a
currentGroup, s a
others)
>               = (a -> (s a, s a) -> (s a, s a)) -> (s a, s a) -> s a -> (s a, s a)
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (\a
a (s a
cg, s a
os) ->
>                           if a -> b
f a
a b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
y
>                           then (a -> s a -> s a
forall c a. Container c a => a -> c -> c
insert a
a s a
cg, s a
os)
>                           else (s a
cg, a -> s a -> s a
forall c a. Container c a => a -> c -> c
insert a
a s a
os)) (s a
forall c a. Container c a => c
empty, s a
forall c a. Container c a => c
empty) s a
xs


Notes on partitionBy:
First, the elements of the set are prefixed by their result under f.
This sorts them by this value, which we can then extract monotonically.
If we have a collection with identical first values,
then the second-projection is monotonic.
Set.splitAt doesn't exist in older versions of containers,
so we use Set.split with Set.findMax instead.

> -- |A fast 'groupBy' for 'Set' objects.
> --
> -- @since 0.2
> partitionBy :: (Ord a, Ord n) => (n -> a) -> Set n -> Set (Set n)
> partitionBy :: (n -> a) -> Set n -> Set (Set n)
partitionBy n -> a
f = (Set (Set n), Set (a, n)) -> Set (Set n)
forall a b. (a, b) -> a
fst ((Set (Set n), Set (a, n)) -> Set (Set n))
-> (Set n -> (Set (Set n), Set (a, n))) -> Set n -> Set (Set n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                 ((Set (Set n), Set (a, n)) -> Bool)
-> ((Set (Set n), Set (a, n)) -> (Set (Set n), Set (a, n)))
-> (Set (Set n), Set (a, n))
-> (Set (Set n), Set (a, n))
forall a. (a -> Bool) -> (a -> a) -> a -> a
until (Set (a, n) -> Bool
forall c a. Container c a => c -> Bool
isEmpty (Set (a, n) -> Bool)
-> ((Set (Set n), Set (a, n)) -> Set (a, n))
-> (Set (Set n), Set (a, n))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (Set n), Set (a, n)) -> Set (a, n)
forall a b. (a, b) -> b
snd)
>                 (\(Set (Set n)
x, Set (a, n)
y) ->
>                      let extracted :: Set (a, n)
extracted  =  ((a, n) -> a) -> a -> Set (a, n) -> Set (a, n)
forall a b. (Ord a, Ord b) => (a -> b) -> b -> Set a -> Set a
extractMonotonic (a, n) -> a
forall a b. (a, b) -> a
fst
>                                        ((a, n) -> a
forall a b. (a, b) -> a
fst (Set (a, n) -> (a, n)
forall (l :: * -> *) a. Linearizable l => l a -> a
chooseOne Set (a, n)
y)) Set (a, n)
y
>                          (Set (a, n)
_, Set (a, n)
y')    =  (a, n) -> Set (a, n) -> (Set (a, n), Set (a, n))
forall a. Ord a => a -> Set a -> (Set a, Set a)
Set.split (Set (a, n) -> (a, n)
forall a. Set a -> a
Set.findMax Set (a, n)
extracted) Set (a, n)
y
>                      in (Set n -> Set (Set n) -> Set (Set n)
forall c a. Container c a => a -> c -> c
insert (((a, n) -> n) -> Set (a, n) -> Set n
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (a, n) -> n
forall a b. (a, b) -> b
snd Set (a, n)
extracted) Set (Set n)
x, Set (a, n)
y')
>                 ) ((Set (Set n), Set (a, n)) -> (Set (Set n), Set (a, n)))
-> (Set n -> (Set (Set n), Set (a, n)))
-> Set n
-> (Set (Set n), Set (a, n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                 (,) Set (Set n)
forall c a. Container c a => c
empty (Set (a, n) -> (Set (Set n), Set (a, n)))
-> (Set n -> Set (a, n)) -> Set n -> (Set (Set n), Set (a, n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> (a, n)) -> Set n -> Set (a, n)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\n
x -> (n -> a
f n
x, n
x))

> -- |A convenience function for the partition refinement operation.
> --
> -- @since 0.2
> refinePartitionBy :: (Ord a, Ord n)
>                      => (n -> a) -> Set (Set n) -> Set (Set n)
> refinePartitionBy :: (n -> a) -> Set (Set n) -> Set (Set n)
refinePartitionBy n -> a
f = (Set n -> Set (Set n) -> Set (Set n))
-> Set (Set n) -> Set (Set n) -> Set (Set n)
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Set (Set n) -> Set (Set n) -> Set (Set n)
forall c a. Container c a => c -> c -> c
union (Set (Set n) -> Set (Set n) -> Set (Set n))
-> (Set n -> Set (Set n)) -> Set n -> Set (Set n) -> Set (Set n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> a) -> Set n -> Set (Set n)
forall a n. (Ord a, Ord n) => (n -> a) -> Set n -> Set (Set n)
partitionBy n -> a
f) Set (Set n)
forall c a. Container c a => c
empty

> -- |Build a 'Container' from the elements of a 'Collapsible'.
> -- This can be used to cast between most types of 'Container'.
> -- Time complexity is \(O(nci)\), where \(n\) is the number of
> -- elements in the source, \(c\) is the cost of accessing a next
> -- element of the source, and \(i\) is the cost of inserting
> -- an element into the destination.
> fromCollapsible :: (Collapsible s, Container c a) => s a -> c
> fromCollapsible :: s a -> c
fromCollapsible = (a -> c -> c) -> c -> s a -> c
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse a -> c -> c
forall c a. Container c a => a -> c -> c
insert c
forall c a. Container c a => c
empty
> {-# INLINE[1] fromCollapsible #-}
> {-# RULES
> "fromCollapsible/multisetFromSet"
>         fromCollapsible = Multiset . Set.mapMonotonic (flip (,) 1)
> "fromCollapsible/setFromMultiset"  fromCollapsible = setFromMultiset
> "fromCollapsible/setFromList"      forall (xs :: Ord a => [a]).
>                                    fromCollapsible xs = Set.fromList xs
>   #-}


Standard Prelude Types
=======================

A Haskell list is a Collapsible Container:

> instance Linearizable []
>     where choose :: [a] -> (a, [a])
choose [a]
xs = ( if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
>                         then [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot choose from an empty list"
>                         else [a] -> a
forall a. [a] -> a
head [a]
xs
>                       , Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
xs
>                       )
> instance Collapsible []
>     where collapse :: (a -> b -> b) -> b -> [a] -> b
collapse = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
> instance Container [a] a
>     where contains :: a -> [a] -> Bool
contains = a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
>           union :: [a] -> [a] -> [a]
union = [a] -> [a] -> [a]
forall (c :: * -> *) a.
(Linearizable c, Container (c a) a) =>
c a -> c a -> c a
interleave
>           intersection :: [a] -> [a] -> [a]
intersection [a]
a [a]
b = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter ([a] -> a -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn [a]
a) [a]
b
>           difference :: [a] -> [a] -> [a]
difference [a]
a [a]
b = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter ([a] -> a -> Bool
forall c a. (Container c a, Eq a) => c -> a -> Bool
isNotIn [a]
b) [a]
a
>           empty :: [a]
empty = []
>           isEmpty :: [a] -> Bool
isEmpty = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
>           insert :: a -> [a] -> [a]
insert = (:)

These definitions for intersection and difference do not care
about multiplicity, and neither do the derived subset operations.
A Set is like a list with no duplicates, so it should act similarly:

> instance Linearizable Set
>     where choose :: Set a -> (a, Set a)
choose Set a
xs
>               | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
xs
>                   = ( [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot choose from an empty set"
>                     , Set a
forall a. Set a
Set.empty)
>               | Bool
otherwise = Set a -> (a, Set a)
forall a. Set a -> (a, Set a)
Set.deleteFindMin Set a
xs
> instance Collapsible Set
>     where collapse :: (a -> b -> b) -> b -> Set a -> b
collapse = (a -> b -> b) -> b -> Set a -> b
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold
>           size :: Set b -> a
size = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> (Set b -> Int) -> Set b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set b -> Int
forall a. Set a -> Int
Set.size
> instance (Ord a) => Container (Set a) a
>     where contains :: a -> Set a -> Bool
contains            =  a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member
>           union :: Set a -> Set a -> Set a
union               =  Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union
>           intersection :: Set a -> Set a -> Set a
intersection        =  Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
>           difference :: Set a -> Set a -> Set a
difference          =  Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
(Set.\\)
>           empty :: Set a
empty               =  Set a
forall a. Set a
Set.empty
>           isEmpty :: Set a -> Bool
isEmpty             =  Set a -> Bool
forall a. Set a -> Bool
Set.null
>           insert :: a -> Set a -> Set a
insert              =  a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert
>           isSubsetOf :: Set a -> Set a -> Bool
isSubsetOf          =  (Set a -> Set a -> Bool) -> Set a -> Set a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf
>           isProperSubsetOf :: Set a -> Set a -> Bool
isProperSubsetOf    =  (Set a -> Set a -> Bool) -> Set a -> Set a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isProperSubsetOf
>           isSupersetOf :: Set a -> Set a -> Bool
isSupersetOf        =  Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf
>           isProperSupersetOf :: Set a -> Set a -> Bool
isProperSupersetOf  =  Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isProperSubsetOf


A new Multiset type, able to contain duplicates but still have
lookup-time logarithmic in the number of distinct elements.

> -- |A 'Multiset' is a 'Set' that may contain more than one instance
> -- of any given element.
> newtype Multiset a = Multiset (Set (a, Integer)) deriving (Multiset a -> Multiset a -> Bool
(Multiset a -> Multiset a -> Bool)
-> (Multiset a -> Multiset a -> Bool) -> Eq (Multiset a)
forall a. Eq a => Multiset a -> Multiset a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Multiset a -> Multiset a -> Bool
$c/= :: forall a. Eq a => Multiset a -> Multiset a -> Bool
== :: Multiset a -> Multiset a -> Bool
$c== :: forall a. Eq a => Multiset a -> Multiset a -> Bool
Eq, Eq (Multiset a)
Eq (Multiset a)
-> (Multiset a -> Multiset a -> Ordering)
-> (Multiset a -> Multiset a -> Bool)
-> (Multiset a -> Multiset a -> Bool)
-> (Multiset a -> Multiset a -> Bool)
-> (Multiset a -> Multiset a -> Bool)
-> (Multiset a -> Multiset a -> Multiset a)
-> (Multiset a -> Multiset a -> Multiset a)
-> Ord (Multiset a)
Multiset a -> Multiset a -> Bool
Multiset a -> Multiset a -> Ordering
Multiset a -> Multiset a -> Multiset 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. Ord a => Eq (Multiset a)
forall a. Ord a => Multiset a -> Multiset a -> Bool
forall a. Ord a => Multiset a -> Multiset a -> Ordering
forall a. Ord a => Multiset a -> Multiset a -> Multiset a
min :: Multiset a -> Multiset a -> Multiset a
$cmin :: forall a. Ord a => Multiset a -> Multiset a -> Multiset a
max :: Multiset a -> Multiset a -> Multiset a
$cmax :: forall a. Ord a => Multiset a -> Multiset a -> Multiset a
>= :: Multiset a -> Multiset a -> Bool
$c>= :: forall a. Ord a => Multiset a -> Multiset a -> Bool
> :: Multiset a -> Multiset a -> Bool
$c> :: forall a. Ord a => Multiset a -> Multiset a -> Bool
<= :: Multiset a -> Multiset a -> Bool
$c<= :: forall a. Ord a => Multiset a -> Multiset a -> Bool
< :: Multiset a -> Multiset a -> Bool
$c< :: forall a. Ord a => Multiset a -> Multiset a -> Bool
compare :: Multiset a -> Multiset a -> Ordering
$ccompare :: forall a. Ord a => Multiset a -> Multiset a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Multiset a)
Ord)

> -- |Analogous to 'isIn', returning the number of occurrences of an
> -- element in a 'Multiset'.
> -- Time complexity is \(O(\log{n})\),
> -- where \(n\) is the number of distinct elements in the 'Multiset'.
> multiplicity :: (Ord a) => Multiset a -> a -> Integer
> multiplicity :: Multiset a -> a -> Integer
multiplicity (Multiset Set (a, Integer)
xs) a
x = Integer
-> (((a, Integer), Set (a, Integer)) -> Integer)
-> Maybe ((a, Integer), Set (a, Integer))
-> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 ((a, Integer) -> Integer
forall p. Num p => (a, p) -> p
f ((a, Integer) -> Integer)
-> (((a, Integer), Set (a, Integer)) -> (a, Integer))
-> ((a, Integer), Set (a, Integer))
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Integer), Set (a, Integer)) -> (a, Integer)
forall a b. (a, b) -> a
fst)  (Maybe ((a, Integer), Set (a, Integer)) -> Integer)
-> ((Set (a, Integer), Set (a, Integer))
    -> Maybe ((a, Integer), Set (a, Integer)))
-> (Set (a, Integer), Set (a, Integer))
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                                Set (a, Integer) -> Maybe ((a, Integer), Set (a, Integer))
forall a. Set a -> Maybe (a, Set a)
Set.minView (Set (a, Integer) -> Maybe ((a, Integer), Set (a, Integer)))
-> ((Set (a, Integer), Set (a, Integer)) -> Set (a, Integer))
-> (Set (a, Integer), Set (a, Integer))
-> Maybe ((a, Integer), Set (a, Integer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (a, Integer), Set (a, Integer)) -> Set (a, Integer)
forall a b. (a, b) -> b
snd  ((Set (a, Integer), Set (a, Integer)) -> Integer)
-> (Set (a, Integer), Set (a, Integer)) -> Integer
forall a b. (a -> b) -> a -> b
$
>                                (a, Integer)
-> Set (a, Integer) -> (Set (a, Integer), Set (a, Integer))
forall a. Ord a => a -> Set a -> (Set a, Set a)
Set.split (a
x, Integer
0) Set (a, Integer)
xs
>     where f :: (a, p) -> p
f (a
y, p
m)
>               | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x     =  p
m
>               | Bool
otherwise  =  p
0

> -- |Every multiplicity that occurs in the multiset.
> --
> -- @since 1.0
> multiplicities :: (Ord a) => Multiset a -> Set Integer
> multiplicities :: Multiset a -> Set Integer
multiplicities (Multiset Set (a, Integer)
xs) = ((a, Integer) -> Integer) -> Set (a, Integer) -> Set Integer
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (a, Integer) -> Integer
forall a b. (a, b) -> b
snd Set (a, Integer)
xs

> -- |A specialization of 'fromCollapsible'
> -- with time complexity \(O(n)\),
> -- where \(n\) is the number of distinct elements in the source.
> setFromMultiset :: Multiset a -> Set a
> setFromMultiset :: Multiset a -> Set a
setFromMultiset (Multiset Set (a, Integer)
a) = ((a, Integer) -> a) -> Set (a, Integer) -> Set a
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (a, Integer) -> a
forall a b. (a, b) -> a
fst Set (a, Integer)
a

> instance Linearizable Multiset
>     where choose :: Multiset a -> (a, Multiset a)
choose (Multiset Set (a, Integer)
xs)
>               | Set (a, Integer) -> Bool
forall a. Set a -> Bool
Set.null Set (a, Integer)
xs
>                   =  ( [Char] -> a
forall a. HasCallStack => [Char] -> a
error
>                        [Char]
"cannot choose from an empty multiset"
>                      , Set (a, Integer) -> Multiset a
forall a. Set (a, Integer) -> Multiset a
Multiset Set (a, Integer)
forall a. Set a
Set.empty)
>               | Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1       =  (a
a, [(a, Integer)] -> Multiset a
forall a. [(a, Integer)] -> Multiset a
f [(a, Integer)]
as)
>               | Bool
otherwise    =  (a
a, [(a, Integer)] -> Multiset a
forall a. [(a, Integer)] -> Multiset a
f ((a
a, Integer -> Integer
forall a. Enum a => a -> a
pred Integer
m) (a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
: [(a, Integer)]
as))
>               where ((a
a,Integer
m):[(a, Integer)]
as) = Set (a, Integer) -> [(a, Integer)]
forall a. Set a -> [a]
Set.toAscList Set (a, Integer)
xs
>                     f :: [(a, Integer)] -> Multiset a
f = Set (a, Integer) -> Multiset a
forall a. Set (a, Integer) -> Multiset a
Multiset (Set (a, Integer) -> Multiset a)
-> ([(a, Integer)] -> Set (a, Integer))
-> [(a, Integer)]
-> Multiset a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, Integer)] -> Set (a, Integer)
forall a. [a] -> Set a
Set.fromDistinctAscList
> instance Collapsible Multiset
>     where size :: Multiset b -> a
size (Multiset Set (b, Integer)
xs) = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> a)
-> ([(b, Integer)] -> Integer) -> [(b, Integer)] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Integer] -> Integer)
-> ([(b, Integer)] -> [Integer]) -> [(b, Integer)] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, Integer) -> Integer) -> [(b, Integer)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (b, Integer) -> Integer
forall a b. (a, b) -> b
snd
>                                ([(b, Integer)] -> a) -> [(b, Integer)] -> a
forall a b. (a -> b) -> a -> b
$ Set (b, Integer) -> [(b, Integer)]
forall a. Set a -> [a]
Set.toList Set (b, Integer)
xs
>           collapse :: (a -> b -> b) -> b -> Multiset a -> b
collapse a -> b -> b
f b
x (Multiset Set (a, Integer)
xs)
>               = (a -> b -> b) -> b -> [a] -> b
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse a -> b -> b
f b
x ([a] -> b) -> ([(a, Integer)] -> [a]) -> [(a, Integer)] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                 ((a, Integer) -> [a]) -> [(a, Integer)] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((a -> Int -> [a]) -> (a, Int) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> a -> [a]) -> a -> Int -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> a -> [a]
forall a. Int -> a -> [a]
replicate) ((a, Int) -> [a])
-> ((a, Integer) -> (a, Int)) -> (a, Integer) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                            (Integer -> Int) -> (a, Integer) -> (a, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([(a, Integer)] -> b) -> [(a, Integer)] -> b
forall a b. (a -> b) -> a -> b
$
>                 Set (a, Integer) -> [(a, Integer)]
forall a. Set a -> [a]
Set.toAscList Set (a, Integer)
xs
> instance Ord a => Container (Multiset a) a
>     where contains :: a -> Multiset a -> Bool
contains a
x = a -> Set a -> Bool
forall c a. (Container c a, Eq a) => a -> c -> Bool
contains a
x (Set a -> Bool) -> (Multiset a -> Set a) -> Multiset a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiset a -> Set a
forall a. Multiset a -> Set a
setFromMultiset
>           insert :: a -> Multiset a -> Multiset a
insert a
x (Multiset Set (a, Integer)
xs) = Set (a, Integer) -> Multiset a
forall a. Set (a, Integer) -> Multiset a
Multiset ((a, Integer) -> Set (a, Integer) -> Set (a, Integer)
forall c a. Container c a => a -> c -> c
insert (a, Integer)
newX Set (a, Integer)
noX)
>               where hasX :: Set (a, Integer)
hasX = ((a, Integer) -> Bool) -> Set (a, Integer) -> Set (a, Integer)
forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) (a -> Bool) -> ((a, Integer) -> a) -> (a, Integer) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Integer) -> a
forall a b. (a, b) -> a
fst) Set (a, Integer)
xs
>                     noX :: Set (a, Integer)
noX  = Set (a, Integer) -> Set (a, Integer) -> Set (a, Integer)
forall c a. (Container c a, Eq a) => c -> c -> c
difference Set (a, Integer)
xs Set (a, Integer)
hasX
>                     newX :: (a, Integer)
newX = ((a, Integer) -> (a, Integer) -> (a, Integer))
-> (a, Integer) -> Set (a, Integer) -> (a, Integer)
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold (a, Integer) -> (a, Integer) -> (a, Integer)
forall b a a. Num b => (a, b) -> (a, b) -> (a, b)
add (a
x, Integer
1) Set (a, Integer)
hasX
>                     add :: (a, b) -> (a, b) -> (a, b)
add (a
a, b
c1) (a
_, b
c2) = (a
a, b
c1 b -> b -> b
forall a. Num a => a -> a -> a
+ b
c2)
>           empty :: Multiset a
empty = Set (a, Integer) -> Multiset a
forall a. Set (a, Integer) -> Multiset a
Multiset Set (a, Integer)
forall c a. Container c a => c
empty
>           isEmpty :: Multiset a -> Bool
isEmpty (Multiset Set (a, Integer)
xs) = Set (a, Integer) -> Bool
forall c a. Container c a => c -> Bool
isEmpty Set (a, Integer)
xs
>           union :: Multiset a -> Multiset a -> Multiset a
union (Multiset Set (a, Integer)
xs) (Multiset Set (a, Integer)
ys)
>               = Set (a, Integer) -> Multiset a
forall a. Set (a, Integer) -> Multiset a
Multiset ([(a, Integer)] -> Set (a, Integer)
forall a. [a] -> Set a
Set.fromDistinctAscList [(a, Integer)]
zs)
>                 where xs' :: [(a, Integer)]
xs' = Set (a, Integer) -> [(a, Integer)]
forall a. Set a -> [a]
Set.toAscList Set (a, Integer)
xs
>                       ys' :: [(a, Integer)]
ys' = Set (a, Integer) -> [(a, Integer)]
forall a. Set a -> [a]
Set.toAscList Set (a, Integer)
ys
>                       zs :: [(a, Integer)]
zs  = [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
unionSortedMultis [(a, Integer)]
xs' [(a, Integer)]
ys'
>           intersection :: Multiset a -> Multiset a -> Multiset a
intersection (Multiset Set (a, Integer)
xs) (Multiset Set (a, Integer)
ys)
>               = Set (a, Integer) -> Multiset a
forall a. Set (a, Integer) -> Multiset a
Multiset ([(a, Integer)] -> Set (a, Integer)
forall a. [a] -> Set a
Set.fromDistinctAscList [(a, Integer)]
zs)
>                 where xs' :: [(a, Integer)]
xs' = Set (a, Integer) -> [(a, Integer)]
forall a. Set a -> [a]
Set.toAscList Set (a, Integer)
xs
>                       ys' :: [(a, Integer)]
ys' = Set (a, Integer) -> [(a, Integer)]
forall a. Set a -> [a]
Set.toAscList Set (a, Integer)
ys
>                       zs :: [(a, Integer)]
zs  = [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
intersectSortedMultis [(a, Integer)]
xs' [(a, Integer)]
ys'
>           difference :: Multiset a -> Multiset a -> Multiset a
difference (Multiset Set (a, Integer)
xs) (Multiset Set (a, Integer)
ys)
>               = Set (a, Integer) -> Multiset a
forall a. Set (a, Integer) -> Multiset a
Multiset ([(a, Integer)] -> Set (a, Integer)
forall a. [a] -> Set a
Set.fromDistinctAscList [(a, Integer)]
zs)
>                 where xs' :: [(a, Integer)]
xs' = Set (a, Integer) -> [(a, Integer)]
forall a. Set a -> [a]
Set.toAscList Set (a, Integer)
xs
>                       ys' :: [(a, Integer)]
ys' = Set (a, Integer) -> [(a, Integer)]
forall a. Set a -> [a]
Set.toAscList Set (a, Integer)
ys
>                       zs :: [(a, Integer)]
zs  = [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
differenceSortedMultis [(a, Integer)]
xs' [(a, Integer)]
ys'

#if MIN_VERSION_base(4,9,0)
> instance Ord a => Semigroup (Multiset a)
>     where <> :: Multiset a -> Multiset a -> Multiset a
(<>) = Multiset a -> Multiset a -> Multiset a
forall a. Monoid a => a -> a -> a
mappend
#endif

> instance Ord a => Monoid (Multiset a)
>     where mempty :: Multiset a
mempty = Multiset a
forall c a. Container c a => c
empty
>           mappend :: Multiset a -> Multiset a -> Multiset a
mappend = Multiset a -> Multiset a -> Multiset a
forall c a. Container c a => c -> c -> c
union

> instance Show a => Show (Multiset a)
>     where showsPrec :: Int -> Multiset a -> ShowS
showsPrec Int
p Multiset a
m = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
>                           [Char] -> ShowS
showString [Char]
"multisetFromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                           [a] -> ShowS
forall a. Show a => a -> ShowS
shows ((a -> [a] -> [a]) -> [a] -> Multiset a -> [a]
forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (:) [] Multiset a
m)
> instance (Ord a, Read a) => Read (Multiset a)
>     where readsPrec :: Int -> ReadS (Multiset a)
readsPrec Int
p = Bool -> ReadS (Multiset a) -> ReadS (Multiset a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Multiset a) -> ReadS (Multiset a))
-> ReadS (Multiset a) -> ReadS (Multiset a)
forall a b. (a -> b) -> a -> b
$ \[Char]
r ->
>                         do ([Char]
"multisetFromList", [Char]
s) <- ReadS [Char]
lex [Char]
r
>                            ([a]
xs, [Char]
t) <- ReadS [a]
forall a. Read a => ReadS a
reads [Char]
s
>                            (Multiset a, [Char]) -> [(Multiset a, [Char])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Multiset a
forall a. Ord a => [a] -> Multiset a
multisetFromList [a]
xs, [Char]
t)

> -- |A specialization of 'fromCollapsible'.
> multisetFromList :: Ord a => [a] -> Multiset a
> multisetFromList :: [a] -> Multiset a
multisetFromList = [a] -> Multiset a
forall (s :: * -> *) c a.
(Collapsible s, Container c a) =>
s a -> c
fromCollapsible

> unionSortedMultis :: Ord a =>
>                      [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
> unionSortedMultis :: [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
unionSortedMultis [(a, Integer)]
xs [] = [(a, Integer)]
xs
> unionSortedMultis [] [(a, Integer)]
ys = [(a, Integer)]
ys
> unionSortedMultis ((a, Integer)
x:[(a, Integer)]
xs) ((a, Integer)
y:[(a, Integer)]
ys)
>     | (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
y  =  (a, Integer)
x (a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
: [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
unionSortedMultis [(a, Integer)]
xs ((a, Integer)
y(a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
:[(a, Integer)]
ys)
>     | (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
y  =  (a, Integer)
y (a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
: [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
unionSortedMultis ((a, Integer)
x(a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
:[(a, Integer)]
xs) [(a, Integer)]
ys
>     | Bool
otherwise      =  [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
unionSortedMultis (((a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
x, (a, Integer) -> Integer
forall a b. (a, b) -> b
snd (a, Integer)
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (a, Integer) -> Integer
forall a b. (a, b) -> b
snd (a, Integer)
y) (a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
: [(a, Integer)]
xs) [(a, Integer)]
ys

> intersectSortedMultis :: Ord a =>
>                          [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
> intersectSortedMultis :: [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
intersectSortedMultis [(a, Integer)]
_ [] = []
> intersectSortedMultis [] [(a, Integer)]
_ = []
> intersectSortedMultis ((a, Integer)
x:[(a, Integer)]
xs) ((a, Integer)
y:[(a, Integer)]
ys)
>     | (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
y  =  [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
intersectSortedMultis [(a, Integer)]
xs ((a, Integer)
y(a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
:[(a, Integer)]
ys)
>     | (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
y  =  [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
intersectSortedMultis ((a, Integer)
x(a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
:[(a, Integer)]
xs) [(a, Integer)]
ys
>     | Bool
otherwise      =  ((a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
x, Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min ((a, Integer) -> Integer
forall a b. (a, b) -> b
snd (a, Integer)
x) ((a, Integer) -> Integer
forall a b. (a, b) -> b
snd (a, Integer)
y)) (a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
:
>                         [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
intersectSortedMultis [(a, Integer)]
xs [(a, Integer)]
ys

> differenceSortedMultis :: Ord a =>
>                           [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
> differenceSortedMultis :: [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
differenceSortedMultis [(a, Integer)]
xs [] = [(a, Integer)]
xs
> differenceSortedMultis [] [(a, Integer)]
_  = []
> differenceSortedMultis ((a, Integer)
x:[(a, Integer)]
xs) ((a, Integer)
y:[(a, Integer)]
ys)
>     | (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
y   =  (a, Integer)
x (a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
: [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
differenceSortedMultis [(a, Integer)]
xs ((a, Integer)
y(a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
:[(a, Integer)]
ys)
>     | (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> (a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
y   =  [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
differenceSortedMultis ((a, Integer)
x(a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
:[(a, Integer)]
xs) [(a, Integer)]
ys
>     | (a, Integer) -> Integer
forall a b. (a, b) -> b
snd (a, Integer)
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= (a, Integer) -> Integer
forall a b. (a, b) -> b
snd (a, Integer)
y  =  [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
differenceSortedMultis [(a, Integer)]
xs [(a, Integer)]
ys
>     | Bool
otherwise       =  ((a, Integer) -> a
forall a b. (a, b) -> a
fst (a, Integer)
x, (a, Integer) -> Integer
forall a b. (a, b) -> b
snd (a, Integer)
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (a, Integer) -> Integer
forall a b. (a, b) -> b
snd (a, Integer)
y) (a, Integer) -> [(a, Integer)] -> [(a, Integer)]
forall a. a -> [a] -> [a]
:
>                          [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
differenceSortedMultis [(a, Integer)]
xs [(a, Integer)]
ys


Subsets sorted by increasing and decreasing size
================================================

> -- |Wrap a 'Collapsible' type to sort in order of increasing size.
> -- For elements of the same size, treat them normally.
> newtype IncreasingSize x = IncreasingSize
>     { IncreasingSize x -> x
getIncreasing :: x } deriving (IncreasingSize x -> IncreasingSize x -> Bool
(IncreasingSize x -> IncreasingSize x -> Bool)
-> (IncreasingSize x -> IncreasingSize x -> Bool)
-> Eq (IncreasingSize x)
forall x. Eq x => IncreasingSize x -> IncreasingSize x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IncreasingSize x -> IncreasingSize x -> Bool
$c/= :: forall x. Eq x => IncreasingSize x -> IncreasingSize x -> Bool
== :: IncreasingSize x -> IncreasingSize x -> Bool
$c== :: forall x. Eq x => IncreasingSize x -> IncreasingSize x -> Bool
Eq, ReadPrec [IncreasingSize x]
ReadPrec (IncreasingSize x)
Int -> ReadS (IncreasingSize x)
ReadS [IncreasingSize x]
(Int -> ReadS (IncreasingSize x))
-> ReadS [IncreasingSize x]
-> ReadPrec (IncreasingSize x)
-> ReadPrec [IncreasingSize x]
-> Read (IncreasingSize x)
forall x. Read x => ReadPrec [IncreasingSize x]
forall x. Read x => ReadPrec (IncreasingSize x)
forall x. Read x => Int -> ReadS (IncreasingSize x)
forall x. Read x => ReadS [IncreasingSize x]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IncreasingSize x]
$creadListPrec :: forall x. Read x => ReadPrec [IncreasingSize x]
readPrec :: ReadPrec (IncreasingSize x)
$creadPrec :: forall x. Read x => ReadPrec (IncreasingSize x)
readList :: ReadS [IncreasingSize x]
$creadList :: forall x. Read x => ReadS [IncreasingSize x]
readsPrec :: Int -> ReadS (IncreasingSize x)
$creadsPrec :: forall x. Read x => Int -> ReadS (IncreasingSize x)
Read, Int -> IncreasingSize x -> ShowS
[IncreasingSize x] -> ShowS
IncreasingSize x -> [Char]
(Int -> IncreasingSize x -> ShowS)
-> (IncreasingSize x -> [Char])
-> ([IncreasingSize x] -> ShowS)
-> Show (IncreasingSize x)
forall x. Show x => Int -> IncreasingSize x -> ShowS
forall x. Show x => [IncreasingSize x] -> ShowS
forall x. Show x => IncreasingSize x -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [IncreasingSize x] -> ShowS
$cshowList :: forall x. Show x => [IncreasingSize x] -> ShowS
show :: IncreasingSize x -> [Char]
$cshow :: forall x. Show x => IncreasingSize x -> [Char]
showsPrec :: Int -> IncreasingSize x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> IncreasingSize x -> ShowS
Show)

> -- |Wrap a 'Collapsible' type to sort in order of decreasing size.
> -- For elements of the same size, treat them normally.
> newtype DecreasingSize x = DecreasingSize
>     { DecreasingSize x -> x
getDecreasing :: x } deriving (DecreasingSize x -> DecreasingSize x -> Bool
(DecreasingSize x -> DecreasingSize x -> Bool)
-> (DecreasingSize x -> DecreasingSize x -> Bool)
-> Eq (DecreasingSize x)
forall x. Eq x => DecreasingSize x -> DecreasingSize x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecreasingSize x -> DecreasingSize x -> Bool
$c/= :: forall x. Eq x => DecreasingSize x -> DecreasingSize x -> Bool
== :: DecreasingSize x -> DecreasingSize x -> Bool
$c== :: forall x. Eq x => DecreasingSize x -> DecreasingSize x -> Bool
Eq, ReadPrec [DecreasingSize x]
ReadPrec (DecreasingSize x)
Int -> ReadS (DecreasingSize x)
ReadS [DecreasingSize x]
(Int -> ReadS (DecreasingSize x))
-> ReadS [DecreasingSize x]
-> ReadPrec (DecreasingSize x)
-> ReadPrec [DecreasingSize x]
-> Read (DecreasingSize x)
forall x. Read x => ReadPrec [DecreasingSize x]
forall x. Read x => ReadPrec (DecreasingSize x)
forall x. Read x => Int -> ReadS (DecreasingSize x)
forall x. Read x => ReadS [DecreasingSize x]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecreasingSize x]
$creadListPrec :: forall x. Read x => ReadPrec [DecreasingSize x]
readPrec :: ReadPrec (DecreasingSize x)
$creadPrec :: forall x. Read x => ReadPrec (DecreasingSize x)
readList :: ReadS [DecreasingSize x]
$creadList :: forall x. Read x => ReadS [DecreasingSize x]
readsPrec :: Int -> ReadS (DecreasingSize x)
$creadsPrec :: forall x. Read x => Int -> ReadS (DecreasingSize x)
Read, Int -> DecreasingSize x -> ShowS
[DecreasingSize x] -> ShowS
DecreasingSize x -> [Char]
(Int -> DecreasingSize x -> ShowS)
-> (DecreasingSize x -> [Char])
-> ([DecreasingSize x] -> ShowS)
-> Show (DecreasingSize x)
forall x. Show x => Int -> DecreasingSize x -> ShowS
forall x. Show x => [DecreasingSize x] -> ShowS
forall x. Show x => DecreasingSize x -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DecreasingSize x] -> ShowS
$cshowList :: forall x. Show x => [DecreasingSize x] -> ShowS
show :: DecreasingSize x -> [Char]
$cshow :: forall x. Show x => DecreasingSize x -> [Char]
showsPrec :: Int -> DecreasingSize x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> DecreasingSize x -> ShowS
Show)

> instance (Collapsible x, Ord (x a)) => Ord (IncreasingSize (x a))
>     where compare :: IncreasingSize (x a) -> IncreasingSize (x a) -> Ordering
compare (IncreasingSize x a
x) (IncreasingSize x a
y)
>               = case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (x a -> Integer
forall (c :: * -> *) b. Collapsible c => c b -> Integer
isize x a
x) (x a -> Integer
forall (c :: * -> *) b. Collapsible c => c b -> Integer
isize x a
y)
>                 of Ordering
LT  ->  Ordering
LT
>                    Ordering
GT  ->  Ordering
GT
>                    Ordering
_   ->  x a -> x a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare x a
x x a
y

> instance (Collapsible x, Ord (x a)) => Ord (DecreasingSize (x a))
>     where compare :: DecreasingSize (x a) -> DecreasingSize (x a) -> Ordering
compare (DecreasingSize x a
x) (DecreasingSize x a
y)
>               = case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (x a -> Integer
forall (c :: * -> *) b. Collapsible c => c b -> Integer
isize x a
x) (x a -> Integer
forall (c :: * -> *) b. Collapsible c => c b -> Integer
isize x a
y)
>                 of Ordering
LT  ->  Ordering
GT
>                    Ordering
GT  ->  Ordering
LT
>                    Ordering
_   ->  x a -> x a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare x a
x x a
y

> instance Functor IncreasingSize
>     where fmap :: (a -> b) -> IncreasingSize a -> IncreasingSize b
fmap a -> b
f (IncreasingSize a
x) = b -> IncreasingSize b
forall x. x -> IncreasingSize x
IncreasingSize (a -> b
f a
x)

> instance Functor DecreasingSize
>     where fmap :: (a -> b) -> DecreasingSize a -> DecreasingSize b
fmap a -> b
f (DecreasingSize a
x) = b -> DecreasingSize b
forall x. x -> DecreasingSize x
DecreasingSize (a -> b
f a
x)


Miscellaneous functions
=======================

> -- |Translate elements.  All instances of elements of the search set
> -- are replaced by the corresponding elements of the replacement set
> -- in the given string.  If the replacement set is smaller than the
> -- search set, it is made longer by repeating the last element.
> --
> -- >>> tr "aeiou" "x" "colorless green ideas"
> -- "cxlxrlxss grxxn xdxxs"
> -- >>> tr "abcdefghijklmnopqrstuvwxyz" "nopqrstuvwxyzabcdefghijklm" "cat"
> -- "png"
> tr :: (Container (s a) a, Collapsible s, Eq a) => [a] -> [a] -> s a -> s a
> tr :: [a] -> [a] -> s a -> s a
tr [a]
search [a]
replace s a
xs = (a -> a) -> s a -> s a
forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap a -> a
translate s a
xs
>     where translate :: a -> a
translate a
x = (a, a) -> a
forall a b. (a, b) -> b
snd ((a, a) -> a) -> ([(a, a)] -> (a, a)) -> [(a, a)] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, a)] -> (a, a)
forall a. [a] -> a
last ([(a, a)] -> (a, a))
-> ([(a, a)] -> [(a, a)]) -> [(a, a)] -> (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a
x, a
x) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:) ([(a, a)] -> [(a, a)])
-> ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> Bool) -> [(a, a)] -> [(a, a)]
forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) (a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> a
fst) ([(a, a)] -> a) -> [(a, a)] -> a
forall a b. (a -> b) -> a -> b
$
>                         [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
search ([a] -> [a]
forall a. [a] -> [a]
makeInfinite [a]
replace)
>           makeInfinite :: [a] -> [a]
makeInfinite []      =  []
>           makeInfinite (a
y:[])  =  a -> [a]
forall a. a -> [a]
repeat a
y
>           makeInfinite (a
y:[a]
ys)  =  a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
makeInfinite [a]
ys

> -- |All possible sequences over a given alphabet,
> -- generated in a breadth-first manner.
> --
> -- @since 0.3
> sequencesOver :: [a] -> [[a]]
> sequencesOver :: [a] -> [[a]]
sequencesOver [a]
a = [] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:
>                   if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
a
>                   then []
>                   else ([a] -> [[a]]) -> [[a]] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[a]
w -> (a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
w) [a]
a) ([a] -> [[a]]
forall a. [a] -> [[a]]
sequencesOver [a]
a)

A fast method to extract elements from a set
that works to find elements whose image under a monotonic function
falls within a given range.
The precondition that for all x,y in xs, x < y ==> f x <= f y
is not checked.

#if MIN_VERSION_containers(0,5,8)
From containers-0.5.8, a range can be extracted from a Set in
guaranteed log-time.

> extractRange :: (Ord a, Ord b) => (a -> b) -> b -> b -> Set a -> Set a
> extractRange :: (a -> b) -> b -> b -> Set a -> Set a
extractRange a -> b
f b
m b
n = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.takeWhileAntitone ((b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
n) (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (Set a -> Set a) -> (Set a -> Set a) -> Set a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                      (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.dropWhileAntitone ((b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
m) (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

#else
If we are using an older version of the containers library
that doesn't contain the necessary functions, we can make do
with a variant that is at least still faster than filter.

> extractRange :: (Ord a, Ord b) => (a -> b) -> b -> b -> Set a -> Set a
> extractRange f m n = Set.fromDistinctAscList .
>                      takeWhile ((<= n) . f) . dropWhile ((< m) . f) .
>                      Set.toAscList

#endif

> -- |A fast method to extract elements from a set
> -- whose image under a monotonic function is a certain value.
> -- The precondition that the function is monotonic is not checked.
> --
> -- @since 0.2
> extractMonotonic :: (Ord a, Ord b) => (a -> b) -> b -> Set a -> Set a
> extractMonotonic :: (a -> b) -> b -> Set a -> Set a
extractMonotonic a -> b
f b
a = (a -> b) -> b -> b -> Set a -> Set a
forall a b. (Ord a, Ord b) => (a -> b) -> b -> b -> Set a -> Set a
extractRange a -> b
f b
a b
a



> -- |Allow for overloading of the term alphabet.
> --
> -- @since 0.3
> class HasAlphabet g
>     where alphabet :: g e -> Set e