{-# LANGUAGE NoImplicitPrelude #-}
module Algebra.Lattice (
C(up, dn)
, max, min, abs
, propUpCommutative, propDnCommutative
, propUpAssociative, propDnAssociative
, propUpDnDistributive, propDnUpDistributive
) where
import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Additive as Additive
import qualified Number.Ratio as Ratio
import qualified Algebra.Laws as Laws
import NumericPrelude hiding (abs)
import PreludeBase hiding (max, min)
import qualified Prelude as P
infixl 5 `up`, `dn`
class C a where
up, dn :: a -> a -> a
{- * Properties -}
propUpCommutative, propDnCommutative ::
(Eq a, C a) => a -> a -> Bool
propUpCommutative = Laws.commutative up
propDnCommutative = Laws.commutative dn
propUpAssociative, propDnAssociative ::
(Eq a, C a) => a -> a -> a -> Bool
propUpAssociative = Laws.associative up
propDnAssociative = Laws.associative dn
propUpDnDistributive, propDnUpDistributive ::
(Eq a, C a) => a -> a -> a -> Bool
propUpDnDistributive = Laws.leftDistributive up dn
propDnUpDistributive = Laws.leftDistributive dn up
-- With @up == gcd@ and @dn == lcm@ we have also a lattice.
instance C Integer where
up = P.max
dn = P.min
instance (Ord a, PID.C a) => C (Ratio.T a) where
up = P.max
dn = P.min
instance C Bool where
up = (P.||)
dn = (P.&&)
instance (C a, C b) => C (a,b) where
(x1,y1)`up`(x2,y2) = (x1`up`x2, y1`up`y2)
(x1,y1)`dn`(x2,y2) = (x1`dn`x2, y1`dn`y2)
max, min :: (C a) => a -> a -> a
max = up
min = dn
abs :: (C a, Additive.C a) => a -> a
abs x = x `up` negate x