> {-# 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
> ( Container(..)
> , Linearizable(..)
> , chooseOne
> , discardOne
> , Collapsible(..)
> , isize
> , zsize
> , fromCollapsible
>
> , unionAll
> , intersectAll
> , interleave
>
> , anyS
> , allS
> , both
> , tmap
> , keep
> , groupBy
> , partitionBy
> , refinePartitionBy
>
> , Multiset
> , multiplicity
> , multiplicities
> , multisetFromList
> , setFromMultiset
>
>
>
>
>
>
>
>
> , IncreasingSize(..)
> , DecreasingSize(..)
>
> , HasAlphabet(..)
>
> , 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.
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
> 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 :: c -> c -> c
>
>
> intersection :: Eq a => c -> c -> c
>
>
> difference :: Eq a => c -> c -> c
>
>
> symmetricDifference :: Eq a => c -> c -> c
> empty :: c
> insert :: a -> c -> c
> singleton :: a -> c
>
> isSubsetOf :: Eq a => c -> c -> Bool
>
> isSupersetOf :: Eq a => c -> c -> Bool
>
>
> isProperSubsetOf :: Eq a => c -> c -> Bool
>
>
> isProperSupersetOf :: Eq a => c -> c -> Bool
>
> 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.
>
>
> class Linearizable l
> where choose :: l a -> (a, l a)
>
>
>
> 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
>
> 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
>
>
>
>
>
>
> 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
>
>
>
>
>
>
>
> 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 #-}
>
> 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
> #-}
>
> 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:
>
> 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
>
>
> 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:
>
> 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
> #-}
>
> 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
> #-}
>
>
>
> 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.
>
> 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
> #-}
>
> 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
> #-}
>
>
>
> 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.
>
>
>
> 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))
>
>
>
> 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
>
>
>
>
>
>
> 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.
>
>
> 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)
>
>
>
>
> 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
>
>
>
> 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
>
>
>
> 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)
>
#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)
>
> 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
================================================
>
>
> 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)
>
>
> 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
=======================
>
>
>
>
>
>
>
>
>
> 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
>
>
>
>
> 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
> 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
>
>
>
>
>
> extractMonotonic :: (Ord a, Ord b) => (a -> b) -> b -> Set a -> Set a
> 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
>
>
>
> class HasAlphabet g
> where alphabet :: g e -> Set e