> {-# 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-2023 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall c a. (Container c a, Eq a) => a -> c -> Bool
contains
>           isNotIn c
c = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn c
c
>           contains = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn
>           doesNotContain = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall c a. (Container c a, Eq a) => c -> a -> Bool
isNotIn
>           insert a
a = forall c a. Container c a => c -> c -> c
union (forall c a. Container c a => a -> c
singleton a
a)
>           singleton a
a = forall c a. Container c a => a -> c -> c
insert a
a forall c a. Container c a => c
empty
>           symmetricDifference c
a c
b
>               = forall c a. (Container c a, Eq a) => c -> c -> c
difference c
a c
b forall c a. Container c a => c -> c -> c
`union` forall c a. (Container c a, Eq a) => c -> c -> c
difference c
b c
a
>           isSubsetOf c
a c
b = forall c a. Container c a => c -> Bool
isEmpty (forall c a. (Container c a, Eq a) => c -> c -> c
difference c
b c
a)
>           isSupersetOf = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall c a. (Container c a, Eq a) => c -> c -> Bool
isSubsetOf
>           isProperSubsetOf c
a c
b = forall c a. (Container c a, Eq a) => c -> c -> Bool
isSubsetOf c
a c
b
>                                  Bool -> Bool -> Bool
&& Bool -> Bool
not (forall c a. Container c a => c -> Bool
isEmpty (forall c a. (Container c a, Eq a) => c -> c -> c
difference c
b c
a))
>           isProperSupersetOf = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall (l :: * -> *) a. Linearizable l => l a -> a
chooseOne   = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (l :: * -> *) a. Linearizable l => l a -> l a
discardOne  = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (c :: * -> *) a.
(Linearizable c, Container (c a) a) =>
c a -> c a -> c a
interleave c a
xs c a
ys
>     | forall c a. Container c a => c -> Bool
isEmpty c a
xs = c a
ys
>     | forall c a. Container c a => c -> Bool
isEmpty c a
ys = c a
xs
>     | Bool
otherwise  = let (a
a, c a
as) = forall (l :: * -> *) a. Linearizable l => l a -> (a, l a)
choose c a
xs
>                        (a
b, c a
bs) = forall (l :: * -> *) a. Linearizable l => l a -> (a, l a)
choose c a
ys
>                    in forall c a. Container c a => a -> c -> c
insert a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. Container c a => a -> c -> c
insert a
b forall a b. (a -> b) -> a -> b
$ 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 = forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((forall a. Eq a => a -> a -> Bool
== Integer
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: * -> *) b. Collapsible c => c b -> Integer
isize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) 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) = 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 = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (forall a b. a -> b -> a
const 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 :: forall (c :: * -> *) b. Collapsible c => c b -> Bool
zsize = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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 :: forall (c :: * -> *) b. Collapsible c => c b -> Integer
isize = 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 :: forall c a (s :: * -> *).
(Container c a, Collapsible s) =>
s c -> c
unionAll = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse forall c a. Container c a => c -> c -> c
union 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 :: forall c a (s :: * -> *).
(Container c a, Eq a, Collapsible s) =>
s c -> c
intersectAll s c
xs
>     | forall (c :: * -> *) b. Collapsible c => c b -> Bool
zsize s c
xs  = forall c a. Container c a => c
empty
>     | Bool
otherwise = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse forall c a. (Container c a, Eq a) => c -> c -> c
intersection c
x s c
xs'
>     where (c
x, s c
xs') = 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 :: forall (s :: * -> *) a. Collapsible s => (a -> Bool) -> s a -> Bool
anyS a -> Bool
f = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Bool -> 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 :: forall (s :: * -> *) a. Collapsible s => (a -> Bool) -> s a -> Bool
allS a -> Bool
f = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (Bool -> 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 :: forall a. (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 :: forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap a -> b
f = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (forall c a. Container c a => a -> c -> c
insert forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall c a. Container c a => c
empty
> {-# 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 :: forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep a -> Bool
f = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse forall {c}. Container c a => a -> c -> c
maybeKeep forall c a. Container c a => c
empty
>     where maybeKeep :: a -> c -> c
maybeKeep a
a c
as
>               | a -> Bool
f a
a        = forall c a. Container c a => a -> c -> c
insert a
a c
as
>               | Bool
otherwise  = c
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 :: 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
xs
>     | forall c a. Container c a => c -> Bool
isEmpty s a
xs  =  forall c a. Container c a => c
empty
>     | Bool
otherwise   =  forall c a. Container c a => a -> c -> c
insert s a
currentGroup forall a b. (a -> b) -> a -> b
$ 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 (forall (l :: * -> *) a. Linearizable l => l a -> a
chooseOne s a
xs)
>           (s a
currentGroup, s a
others)
>               = 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 forall a. Eq a => a -> a -> Bool
== b
y
>                           then (forall c a. Container c a => a -> c -> c
insert a
a s a
cg, s a
os)
>                           else (s a
cg, forall c a. Container c a => a -> c -> c
insert a
a s a
os)) (forall c a. Container c a => c
empty, 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 :: forall a n. (Ord a, Ord n) => (n -> a) -> Set n -> Set (Set n)
partitionBy n -> a
f = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                 forall a. (a -> Bool) -> (a -> a) -> a -> a
until (forall c a. Container c a => c -> Bool
isEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
>                 (\(Set (Set n)
x, Set (a, n)
y) ->
>                      let extracted :: Set (a, n)
extracted  =  forall a b. (Ord a, Ord b) => (a -> b) -> b -> Set a -> Set a
extractMonotonic forall a b. (a, b) -> a
fst
>                                        (forall a b. (a, b) -> a
fst (forall (l :: * -> *) a. Linearizable l => l a -> a
chooseOne Set (a, n)
y)) Set (a, n)
y
>                          (Set (a, n)
_, Set (a, n)
y')    =  forall a. Ord a => a -> Set a -> (Set a, Set a)
Set.split (forall a. Set a -> a
Set.findMax Set (a, n)
extracted) Set (a, n)
y
>                      in (forall c a. Container c a => a -> c -> c
insert (forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic forall a b. (a, b) -> b
snd Set (a, n)
extracted) Set (Set n)
x, Set (a, n)
y')
>                 ) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                 (,) forall c a. Container c a => c
empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a n.
(Ord a, Ord n) =>
(n -> a) -> Set (Set n) -> Set (Set n)
refinePartitionBy n -> a
f = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse (forall c a. Container c a => c -> c -> c
union forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a n. (Ord a, Ord n) => (n -> a) -> Set n -> Set (Set n)
partitionBy n -> a
f) 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 :: forall (s :: * -> *) c a.
(Collapsible s, Container c a) =>
s a -> c
fromCollapsible = forall (c :: * -> *) a b.
Collapsible c =>
(a -> b -> b) -> b -> c a -> b
collapse forall c a. Container c a => a -> c -> c
insert 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 :: forall a. [a] -> (a, [a])
choose [a]
xs = ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
>                         then forall a. HasCallStack => [Char] -> a
error [Char]
"cannot choose from an empty list"
>                         else forall a. [a] -> a
head [a]
xs
>                       , forall a. Int -> [a] -> [a]
drop Int
1 [a]
xs
>                       )
> instance Collapsible []
>     where collapse :: forall a b. (a -> b -> b) -> b -> [a] -> b
collapse = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
> instance Container [a] a
>     where contains :: Eq a => a -> [a] -> Bool
contains = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
>           union :: [a] -> [a] -> [a]
union = forall (c :: * -> *) a.
(Linearizable c, Container (c a) a) =>
c a -> c a -> c a
interleave
>           intersection :: Eq a => [a] -> [a] -> [a]
intersection [a]
a = forall a. (a -> Bool) -> [a] -> [a]
filter (forall c a. (Container c a, Eq a) => c -> a -> Bool
isIn [a]
a)
>           difference :: Eq a => [a] -> [a] -> [a]
difference [a]
a [a]
b = forall a. (a -> Bool) -> [a] -> [a]
filter (forall c a. (Container c a, Eq a) => c -> a -> Bool
isNotIn [a]
b) [a]
a
>           empty :: [a]
empty = []
>           isEmpty :: [a] -> Bool
isEmpty = 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 :: forall a. Set a -> (a, Set a)
choose Set a
xs
>               | forall a. Set a -> Bool
Set.null Set a
xs
>                   = ( forall a. HasCallStack => [Char] -> a
error [Char]
"cannot choose from an empty set"
>                     , forall a. Set a
Set.empty)
>               | Bool
otherwise = forall a. Set a -> (a, Set a)
Set.deleteFindMin Set a
xs
> instance Collapsible Set
>     where collapse :: forall a b. (a -> b -> b) -> b -> Set a -> b
collapse = forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold
>           size :: forall a b. Integral a => Set b -> a
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Int
Set.size
> instance (Ord a) => Container (Set a) a
>     where contains :: Eq a => a -> Set a -> Bool
contains            =  forall a. Ord a => a -> Set a -> Bool
Set.member
>           union :: Set a -> Set a -> Set a
union               =  forall a. Ord a => Set a -> Set a -> Set a
Set.union
>           intersection :: Eq a => Set a -> Set a -> Set a
intersection        =  forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
>           difference :: Eq a => Set a -> Set a -> Set a
difference          =  forall a. Ord a => Set a -> Set a -> Set a
(Set.\\)
>           empty :: Set a
empty               =  forall a. Set a
Set.empty
>           isEmpty :: Set a -> Bool
isEmpty             =  forall a. Set a -> Bool
Set.null
>           insert :: a -> Set a -> Set a
insert              =  forall a. Ord a => a -> Set a -> Set a
Set.insert
>           isSubsetOf :: Eq a => Set a -> Set a -> Bool
isSubsetOf          =  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf
>           isProperSubsetOf :: Eq a => Set a -> Set a -> Bool
isProperSubsetOf    =  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => Set a -> Set a -> Bool
Set.isProperSubsetOf
>           isSupersetOf :: Eq a => Set a -> Set a -> Bool
isSupersetOf        =  forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf
>           isProperSupersetOf :: Eq a => Set a -> Set a -> Bool
isProperSupersetOf  =  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
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, 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
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 :: forall a. Ord a => Multiset a -> a -> Integer
multiplicity (Multiset Set (a, Integer)
xs) a
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 (forall {b}. Num b => (a, b) -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)  forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                                forall a. Set a -> Maybe (a, Set a)
Set.minView forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd  forall a b. (a -> b) -> a -> b
$
>                                forall a. Ord a => a -> Set a -> (Set a, Set a)
Set.split (a
x, Integer
0) Set (a, Integer)
xs
>     where f :: (a, b) -> b
f (a
y, b
m)
>               | a
y forall a. Eq a => a -> a -> Bool
== a
x     =  b
m
>               | Bool
otherwise  =  b
0

> -- |Every multiplicity that occurs in the multiset.
> --
> -- @since 1.0
> multiplicities :: (Ord a) => Multiset a -> Set Integer
> multiplicities :: forall a. Ord a => Multiset a -> Set Integer
multiplicities (Multiset Set (a, Integer)
xs) = forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map 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 :: forall a. Multiset a -> Set a
setFromMultiset (Multiset Set (a, Integer)
a) = forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic forall a b. (a, b) -> a
fst Set (a, Integer)
a

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

> instance Ord a => Monoid (Multiset a)
>     where mempty :: Multiset a
mempty = forall c a. Container c a => c
empty
#if MIN_VERSION_base(4,11,0)
> -- mappend will eventually be removed
#elif MIN_VERSION_base(4,9,0)
>           mappend = (<>)
#else
>           mappend = union
#endif

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

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

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

> intersectSortedMultis :: Ord a =>
>                          [(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
> intersectSortedMultis :: forall a.
Ord a =>
[(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)
>     | forall a b. (a, b) -> a
fst (a, Integer)
x forall a. Ord a => a -> a -> Bool
< forall a b. (a, b) -> a
fst (a, Integer)
y  =  forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
intersectSortedMultis [(a, Integer)]
xs ((a, Integer)
yforall a. a -> [a] -> [a]
:[(a, Integer)]
ys)
>     | forall a b. (a, b) -> a
fst (a, Integer)
x forall a. Ord a => a -> a -> Bool
> forall a b. (a, b) -> a
fst (a, Integer)
y  =  forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
intersectSortedMultis ((a, Integer)
xforall a. a -> [a] -> [a]
:[(a, Integer)]
xs) [(a, Integer)]
ys
>     | Bool
otherwise      =  (forall a b. (a, b) -> a
fst (a, Integer)
x, forall a. Ord a => a -> a -> a
min (forall a b. (a, b) -> b
snd (a, Integer)
x) (forall a b. (a, b) -> b
snd (a, Integer)
y)) forall a. a -> [a] -> [a]
:
>                         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 :: forall a.
Ord a =>
[(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)
>     | forall a b. (a, b) -> a
fst (a, Integer)
x forall a. Ord a => a -> a -> Bool
< forall a b. (a, b) -> a
fst (a, Integer)
y   =  (a, Integer)
x forall a. a -> [a] -> [a]
: forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
differenceSortedMultis [(a, Integer)]
xs ((a, Integer)
yforall a. a -> [a] -> [a]
:[(a, Integer)]
ys)
>     | forall a b. (a, b) -> a
fst (a, Integer)
x forall a. Ord a => a -> a -> Bool
> forall a b. (a, b) -> a
fst (a, Integer)
y   =  forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
differenceSortedMultis ((a, Integer)
xforall a. a -> [a] -> [a]
:[(a, Integer)]
xs) [(a, Integer)]
ys
>     | forall a b. (a, b) -> b
snd (a, Integer)
x forall a. Ord a => a -> a -> Bool
<= forall a b. (a, b) -> b
snd (a, Integer)
y  =  forall a.
Ord a =>
[(a, Integer)] -> [(a, Integer)] -> [(a, Integer)]
differenceSortedMultis [(a, Integer)]
xs [(a, Integer)]
ys
>     | Bool
otherwise       =  (forall a b. (a, b) -> a
fst (a, Integer)
x, forall a b. (a, b) -> b
snd (a, Integer)
x forall a. Num a => a -> a -> a
- forall a b. (a, b) -> b
snd (a, Integer)
y) forall a. a -> [a] -> [a]
:
>                          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
>     { forall x. IncreasingSize x -> x
getIncreasing :: x } deriving (IncreasingSize x -> IncreasingSize x -> Bool
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)
ReadS [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
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
>     { forall x. DecreasingSize x -> x
getDecreasing :: x } deriving (DecreasingSize x -> DecreasingSize x -> Bool
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)
ReadS [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
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 forall a. Ord a => a -> a -> Ordering
compare (forall (c :: * -> *) b. Collapsible c => c b -> Integer
isize x a
x) (forall (c :: * -> *) b. Collapsible c => c b -> Integer
isize x a
y)
>                 of Ordering
LT  ->  Ordering
LT
>                    Ordering
GT  ->  Ordering
GT
>                    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 forall a. Ord a => a -> a -> Ordering
compare (forall (c :: * -> *) b. Collapsible c => c b -> Integer
isize x a
x) (forall (c :: * -> *) b. Collapsible c => c b -> Integer
isize x a
y)
>                 of Ordering
LT  ->  Ordering
GT
>                    Ordering
GT  ->  Ordering
LT
>                    Ordering
_   ->  forall a. Ord a => a -> a -> Ordering
compare x a
x x a
y

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

> instance Functor DecreasingSize
>     where fmap :: forall a b. (a -> b) -> DecreasingSize a -> DecreasingSize b
fmap a -> b
f (DecreasingSize a
x) = 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 :: forall (s :: * -> *) a.
(Container (s a) a, Collapsible s, Eq a) =>
[a] -> [a] -> s a -> s a
tr [a]
search [a]
replace = forall (s :: * -> *) b1 b a.
(Collapsible s, Container (s b1) b) =>
(a -> b) -> s a -> s b1
tmap a -> a
translate
>     where translate :: a -> a
translate a
x = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a
x, a
x) forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) a.
(Collapsible s, Container (s a) a) =>
(a -> Bool) -> s a -> s a
keep ((forall a. Eq a => a -> a -> Bool
== a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
>                         forall a b. [a] -> [b] -> [(a, b)]
zip [a]
search (forall {a}. [a] -> [a]
makeInfinite [a]
replace)
>           makeInfinite :: [a] -> [a]
makeInfinite []      =  []
>           makeInfinite [a
y]     =  forall a. a -> [a]
repeat a
y
>           makeInfinite (a
y:[a]
ys)  =  a
y 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 :: forall a. [a] -> [[a]]
sequencesOver [a]
a = [] forall a. a -> [a] -> [a]
:
>                   if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
a
>                   then []
>                   else forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[a]
w -> forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
: [a]
w) [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 :: forall a b. (Ord a, Ord b) => (a -> b) -> b -> b -> Set a -> Set a
extractRange a -> b
f b
m b
n = forall a. (a -> Bool) -> Set a -> Set a
Set.takeWhileAntitone ((forall a. Ord a => a -> a -> Bool
<= b
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>                      forall a. (a -> Bool) -> Set a -> Set a
Set.dropWhileAntitone ((forall a. Ord a => a -> a -> Bool
< b
m) 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 :: forall a b. (Ord a, Ord b) => (a -> b) -> b -> Set a -> Set a
extractMonotonic a -> b
f b
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