| Safe Haskell | Safe |
|---|---|
| Language | Haskell2010 |
Data.Semilattice
Synopsis
- type (-) (g :: k1 -> k) (f :: k -> k2) (a :: k1) = f (g a)
- type JoinSemilattice a = (Prd a, (Join - Semigroup) a)
- type BoundedJoinSemilattice a = (JoinSemilattice a, (Join - Monoid) a)
- newtype Join a = Join {
- unJoin :: a
- bottom :: (Join - Monoid) a => a
- (∨) :: (Join - Semigroup) a => a -> a -> a
- join :: (Join - Monoid) a => Lattice a => Foldable f => f a -> a
- joinWith :: (Join - Monoid) a => Foldable t => (b -> a) -> t b -> a
- join1 :: Lattice a => Foldable1 f => f a -> a
- joinWith1 :: Foldable1 t => Lattice a => (b -> a) -> t b -> a
- type MeetSemilattice a = (Prd a, (Meet - Semigroup) a)
- type BoundedMeetSemilattice a = (MeetSemilattice a, (Meet - Monoid) a)
- newtype Meet a = Meet {
- unMeet :: a
- top :: (Meet - Monoid) a => a
- (∧) :: (Meet - Semigroup) a => a -> a -> a
- meet :: (Meet - Monoid) a => Lattice a => Foldable f => f a -> a
- meetWith :: (Meet - Monoid) a => Foldable t => (b -> a) -> t b -> a
- meet1 :: Lattice a => Foldable1 f => f a -> a
- meetWith1 :: Foldable1 t => Lattice a => (b -> a) -> t b -> a
- type LatticeLaw a = (JoinSemilattice a, MeetSemilattice a)
- type BoundedLatticeLaw a = (BoundedJoinSemilattice a, BoundedMeetSemilattice a)
- type BoundedLattice a = (Lattice a, BoundedLatticeLaw a)
- type LowerBoundedLattice a = (Lattice a, (Join - Monoid) a)
- type UpperBoundedLattice a = (Lattice a, (Meet - Monoid) a)
- class LatticeLaw a => Lattice a
- glb :: Lattice a => a -> a -> a -> a
- glbWith :: Lattice r => (a -> r) -> a -> a -> a -> r
- lub :: Lattice a => a -> a -> a -> a
- lubWith :: Lattice r => (a -> r) -> a -> a -> a -> r
- eval :: BoundedLattice a => Functor f => Foldable f => Foldable g => f (g a) -> a
- evalWith :: BoundedLattice r => Functor f => Functor g => Foldable f => Foldable g => (a -> r) -> f (g a) -> r
- eval1 :: Lattice a => Functor f => Foldable1 f => Foldable1 g => f (g a) -> a
- evalWith1 :: Lattice r => Functor f => Functor g => Foldable1 f => Foldable1 g => (a -> r) -> f (g a) -> r
- cross :: Foldable f => Applicative f => LowerBoundedLattice a => f a -> f a -> a
- cross1 :: Foldable1 f => Apply f => Lattice a => f a -> f a -> a
Documentation
Join semilattices
type BoundedJoinSemilattice a = (JoinSemilattice a, (Join - Monoid) a) Source #
Instances
(∨) :: (Join - Semigroup) a => a -> a -> a infixr 5 Source #
Join operation on a semilattice.
>>>(> (0::Int)) ∧ ((< 10) ∨ (== 15)) $ 10False
>>>IntSet.fromList [1..5] ∧ IntSet.fromList [2..5]fromList [2,3,4,5]
join1 :: Lattice a => Foldable1 f => f a -> a Source #
The join of a list of join-semilattice elements (of length at least top)
joinWith1 :: Foldable1 t => Lattice a => (b -> a) -> t b -> a Source #
Fold over a non-empty collection using the join operation of an arbitrary join semilattice.
Meet semilattices
type BoundedMeetSemilattice a = (MeetSemilattice a, (Meet - Monoid) a) Source #
Instances
(∧) :: (Meet - Semigroup) a => a -> a -> a infixr 6 Source #
Meet operation on a semilattice.
>>>(> (0::Int)) ∧ ((< 10) ∨ (== 15)) $ 15True
meet1 :: Lattice a => Foldable1 f => f a -> a Source #
The meet of a list of meet-semilattice elements (of length at least top)
meetWith1 :: Foldable1 t => Lattice a => (b -> a) -> t b -> a Source #
Fold over a non-empty collection using the multiplicative operation of a semiring.
As the collection is non-empty this does not require a distinct multiplicative unit:
>>>meetWith1 Just $ 1 :| [2..5 :: Int]Just 120>>>meetWith1 First $ 1 :| [2..(5 :: Int)]First {getFirst = 15}>>>meetWith1 First $ Nothing :| [Just (5 :: Int), Just 6, Nothing]First {getFirst = Just 11}
Lattices
type LatticeLaw a = (JoinSemilattice a, MeetSemilattice a) Source #
type BoundedLatticeLaw a = (BoundedJoinSemilattice a, BoundedMeetSemilattice a) Source #
type BoundedLattice a = (Lattice a, BoundedLatticeLaw a) Source #
class LatticeLaw a => Lattice a Source #
Lattices.
A lattice is a partially ordered set in which every two elements have a unique join (least upper bound or supremum) and a unique meet (greatest lower bound or infimum).
Neutrality
x∨minimal= x x∧maximal= x
Associativity
x∨(y∨z) = (x∨y)∨z x∧(y∧z) = (x∧y)∧z
Commutativity
x∨y = y∨x x∧y = y∧x
Idempotency
x∨x = x x∧x = x
Absorption
(x∨y)∧y = y (x∧y)∨y = y
See http://en.wikipedia.org/wiki/Lattice_(order) and http://en.wikipedia.org/wiki/Absorption_law.
Note that distributivity is _not_ a requirement for a lattice, however distributive lattices are idempotent, commutative dioids.
Instances
glb :: Lattice a => a -> a -> a -> a Source #
Birkhoff's self-dual ternary median operation.
If the lattice is distributive then glb has the following properties.
glbx y y = yglbx y z =glbz x yglbx y z =glbx z yglb(glbx w y) w z =glbx w (glby w z)
>>>glb 1 2 3 :: Int2>>>glb (fromList [1..3]) (fromList [3..5]) (fromList [5..7]) :: Set IntfromList [3,5]
See Property.
glbWith :: Lattice r => (a -> r) -> a -> a -> a -> r Source #
>>>glbWith N5 1 9 7N5 {fromN5 = 7.0}>>>glbWith N5 1 9 (0/0)N5 {fromN5 = 9.0}
lubWith :: Lattice r => (a -> r) -> a -> a -> a -> r Source #
>>>lubWith N5 1 9 7N5 {fromN5 = 7.0}>>>lubWith N5 1 9 (0/0)N5 {fromN5 = 1.0}
eval :: BoundedLattice a => Functor f => Foldable f => Foldable g => f (g a) -> a Source #
Evaluate a lattice expression.
(a11 ∧ .. ∧ a1m) ∨ (a21 ∧ .. ∧ a2n) ∨ ...
>>>eval [[1, 2], [3, 4, 5], [6, 7 :: Int]] -- 1 * 2 + 3 * 414>>>eval $ sequence [[1, 2], [3, 4 :: Int]] -- 1 + 2 * 3 + 421
evalWith :: BoundedLattice r => Functor f => Functor g => Foldable f => Foldable g => (a -> r) -> f (g a) -> r Source #
evalWith1 :: Lattice r => Functor f => Functor g => Foldable1 f => Foldable1 g => (a -> r) -> f (g a) -> r Source #
cross :: Foldable f => Applicative f => LowerBoundedLattice a => f a -> f a -> a Source #
Cross-multiply two collections.
>>>cross [1,3,5 :: Int] [2,4]4
>>>cross [1,2,3 :: Int] []-9223372036854775808