-- | [Lattices](https://en.wikipedia.org/wiki/Lattice_(order\))
module NumHask.Algebra.Lattice
  ( JoinSemiLattice (..),
    joinLeq,
    (<\),
    MeetSemiLattice (..),
    meetLeq,
    (</),
    BoundedJoinSemiLattice (..),
    BoundedMeetSemiLattice (..),
    Lattice,
    BoundedLattice,
  )
where

import Data.Bool (Bool (..), (&&), (||))
import Data.Eq (Eq ((==)))
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Ord (Ord (..))
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Enum (Bounded (..))
import GHC.Float (Double, Float)
import GHC.Int (Int)
import GHC.Natural (Natural (..))
import GHC.Num (Integer)
import GHC.Word (Word)
import NumHask.Algebra.Additive (zero)
import NumHask.Algebra.Field
  ( infinity,
    negInfinity,
  )

-- | A algebraic structure with element joins: See [Semilattice](http://en.wikipedia.org/wiki/Semilattice)
--
-- > Associativity: x \/ (y \/ z) == (x \/ y) \/ z
-- > Commutativity: x \/ y == y \/ x
-- > Idempotency:   x \/ x == x
class (Eq a) => JoinSemiLattice a where
  infixr 5 \/
  (\/) :: a -> a -> a

-- | The partial ordering induced by the join-semilattice structure
joinLeq :: (JoinSemiLattice a) => a -> a -> Bool
joinLeq :: forall a. JoinSemiLattice a => a -> a -> Bool
joinLeq a
x a
y = (a
x forall a. JoinSemiLattice a => a -> a -> a
\/ a
y) forall a. Eq a => a -> a -> Bool
== a
y

infixr 6 <\

-- | The partial ordering induced by the join-semilattice structure
(<\) :: (JoinSemiLattice a) => a -> a -> Bool
<\ :: forall a. JoinSemiLattice a => a -> a -> Bool
(<\) = forall a. JoinSemiLattice a => a -> a -> Bool
joinLeq

-- | A algebraic structure with element meets: See [Semilattice](http://en.wikipedia.org/wiki/Semilattice)
--
-- > Associativity: x /\ (y /\ z) == (x /\ y) /\ z
-- > Commutativity: x /\ y == y /\ x
-- > Idempotency:   x /\ x == x
class (Eq a) => MeetSemiLattice a where
  infixr 6 /\
  (/\) :: a -> a -> a

-- | The partial ordering induced by the meet-semilattice structure
meetLeq :: (MeetSemiLattice a) => a -> a -> Bool
meetLeq :: forall a. MeetSemiLattice a => a -> a -> Bool
meetLeq a
x a
y = (a
x forall a. MeetSemiLattice a => a -> a -> a
/\ a
y) forall a. Eq a => a -> a -> Bool
== a
x

infixr 6 </

-- | The partial ordering induced by the meet-semilattice structure
(</) :: (MeetSemiLattice a) => a -> a -> Bool
</ :: forall a. MeetSemiLattice a => a -> a -> Bool
(</) = forall a. MeetSemiLattice a => a -> a -> Bool
meetLeq

-- | The combination of two semi lattices makes a lattice if the absorption law holds:
-- see [Absorption Law](http://en.wikipedia.org/wiki/Absorption_law) and [Lattice](http://en.wikipedia.org/wiki/Lattice_(order\))
--
-- > Absorption: a \/ (a /\ b) == a /\ (a \/ b) == a
type Lattice a = (JoinSemiLattice a, MeetSemiLattice a)

-- | A join-semilattice with an identity element 'bottom' for '\/'.
--
-- > Identity: x \/ bottom == x
class (JoinSemiLattice a) => BoundedJoinSemiLattice a where
  bottom :: a

-- | A meet-semilattice with an identity element 'top' for '/\'.
--
-- > Identity: x /\ top == x
class (MeetSemiLattice a) => BoundedMeetSemiLattice a where
  top :: a

-- | Lattices with both bounds
type BoundedLattice a = (JoinSemiLattice a, MeetSemiLattice a, BoundedJoinSemiLattice a, BoundedMeetSemiLattice a)

instance JoinSemiLattice Float where
  \/ :: Float -> Float -> Float
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Float where
  /\ :: Float -> Float -> Float
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Double where
  \/ :: Double -> Double -> Double
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Double where
  /\ :: Double -> Double -> Double
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Int where
  \/ :: Int -> Int -> Int
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Int where
  /\ :: Int -> Int -> Int
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Integer where
  \/ :: Integer -> Integer -> Integer
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Integer where
  /\ :: Integer -> Integer -> Integer
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Bool where
  \/ :: Bool -> Bool -> Bool
(\/) = Bool -> Bool -> Bool
(||)

instance MeetSemiLattice Bool where
  /\ :: Bool -> Bool -> Bool
(/\) = Bool -> Bool -> Bool
(&&)

instance JoinSemiLattice Natural where
  \/ :: Natural -> Natural -> Natural
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Natural where
  /\ :: Natural -> Natural -> Natural
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Int8 where
  \/ :: Int8 -> Int8 -> Int8
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Int8 where
  /\ :: Int8 -> Int8 -> Int8
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Int16 where
  \/ :: Int16 -> Int16 -> Int16
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Int16 where
  /\ :: Int16 -> Int16 -> Int16
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Int32 where
  \/ :: Int32 -> Int32 -> Int32
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Int32 where
  /\ :: Int32 -> Int32 -> Int32
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Int64 where
  \/ :: Int64 -> Int64 -> Int64
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Int64 where
  /\ :: Int64 -> Int64 -> Int64
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Word where
  \/ :: Word -> Word -> Word
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Word where
  /\ :: Word -> Word -> Word
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Word8 where
  \/ :: Word8 -> Word8 -> Word8
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Word8 where
  /\ :: Word8 -> Word8 -> Word8
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Word16 where
  \/ :: Word16 -> Word16 -> Word16
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Word16 where
  /\ :: Word16 -> Word16 -> Word16
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Word32 where
  \/ :: Word32 -> Word32 -> Word32
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Word32 where
  /\ :: Word32 -> Word32 -> Word32
(/\) = forall a. Ord a => a -> a -> a
max

instance JoinSemiLattice Word64 where
  \/ :: Word64 -> Word64 -> Word64
(\/) = forall a. Ord a => a -> a -> a
min

instance MeetSemiLattice Word64 where
  /\ :: Word64 -> Word64 -> Word64
(/\) = forall a. Ord a => a -> a -> a
max

instance BoundedJoinSemiLattice Float where
  bottom :: Float
bottom = forall a. Field a => a
negInfinity

instance BoundedMeetSemiLattice Float where
  top :: Float
top = forall a. Field a => a
infinity

instance BoundedJoinSemiLattice Double where
  bottom :: Double
bottom = forall a. Field a => a
negInfinity

instance BoundedMeetSemiLattice Double where
  top :: Double
top = forall a. Field a => a
infinity

instance BoundedJoinSemiLattice Int where
  bottom :: Int
bottom = forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Int where
  top :: Int
top = forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Bool where
  bottom :: Bool
bottom = Bool
False

instance BoundedMeetSemiLattice Bool where
  top :: Bool
top = Bool
True

instance BoundedJoinSemiLattice Natural where
  bottom :: Natural
bottom = forall a. Additive a => a
zero

instance BoundedJoinSemiLattice Int8 where
  bottom :: Int8
bottom = forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Int8 where
  top :: Int8
top = forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Int16 where
  bottom :: Int16
bottom = forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Int16 where
  top :: Int16
top = forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Int32 where
  bottom :: Int32
bottom = forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Int32 where
  top :: Int32
top = forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Int64 where
  bottom :: Int64
bottom = forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Int64 where
  top :: Int64
top = forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Word where
  bottom :: Word
bottom = forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Word where
  top :: Word
top = forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Word8 where
  bottom :: Word8
bottom = forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Word8 where
  top :: Word8
top = forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Word16 where
  bottom :: Word16
bottom = forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Word16 where
  top :: Word16
top = forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Word32 where
  bottom :: Word32
bottom = forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Word32 where
  top :: Word32
top = forall a. Bounded a => a
maxBound

instance BoundedJoinSemiLattice Word64 where
  bottom :: Word64
bottom = forall a. Bounded a => a
minBound

instance BoundedMeetSemiLattice Word64 where
  top :: Word64
top = forall a. Bounded a => a
maxBound