> {-# 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 = (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.
>
>
> class Linearizable l
> where choose :: l a -> (a, l a)
>
>
>
> 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
>
> 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
>
>
>
>
>
>
> 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
>
>
>
>
>
>
>
> 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 #-}
>
> 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
> #-}
>
> 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:
>
> 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
>
>
> 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:
>
> 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
> #-}
>
> 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
> #-}
>
>
>
> 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.
>
> 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
> #-}
>
> 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
> #-}
>
>
>
> 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.
>
>
>
> 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))
>
>
>
> 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
>
>
>
>
>
>
> 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.
>
>
> 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)
>
>
>
>
> 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
>
>
>
> 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
>
>
>
> 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)
>
> 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
================================================
>
>
> 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)
>
>
> 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
=======================
>
>
>
>
>
>
>
>
>
> 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
>
>
>
>
> 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
> 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
>
>
>
>
>
> extractMonotonic :: (Ord a, Ord b) => (a -> b) -> b -> Set a -> Set a
> 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
>
>
>
> class HasAlphabet g
> where alphabet :: g e -> Set e