Skip to content

Commit

Permalink
Deconflict w/ semigroups.
Browse files Browse the repository at this point in the history
  • Loading branch information
cmk committed Dec 2, 2019
1 parent 7968f31 commit b4b12e5
Show file tree
Hide file tree
Showing 5 changed files with 76 additions and 78 deletions.
5 changes: 3 additions & 2 deletions connections.cabal
Original file line number Diff line number Diff line change
@@ -1,13 +1,14 @@
name: connections
version: 0.0.2
version: 0.0.2.1
synopsis: Partial orders & Galois connections.
description: A library for precision rounding using Galois connections.
homepage: https://github.com/cmk/connections
license: BSD3
license-file: LICENSE
author: Chris McKinlay
maintainer: [email protected]
category: Math
category: Math, Numerical
stability: Experimental
build-type: Simple
extra-source-files: ChangeLog.md
cabal-version: >=1.10
Expand Down
4 changes: 2 additions & 2 deletions src/Data/Connection/Float.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,10 +31,10 @@ instance Prd Ulp32 where
| ulp32Nan x || ulp32Nan y = False
| otherwise = on (<~) unUlp32 x y

instance Min Ulp32 where
instance Minimal Ulp32 where
minimal = Ulp32 $ -2139095041

instance Max Ulp32 where
instance Maximal Ulp32 where
maximal = Ulp32 $ 2139095040

instance Bounded Ulp32 where
Expand Down
120 changes: 60 additions & 60 deletions src/Data/Prd.hs
Original file line number Diff line number Diff line change
Expand Up @@ -281,7 +281,7 @@ pmax x y = do
EQ -> Just y
LT -> Just y

pjoin :: Eq a => Min a => Foldable f => f a -> Maybe a
pjoin :: Eq a => Minimal a => Foldable f => f a -> Maybe a
pjoin = foldM pmax minimal

-- | A partial version of 'Data.Ord.min'.
Expand All @@ -296,7 +296,7 @@ pmin x y = do
EQ -> Just x
LT -> Just x

pmeet :: Eq a => Max a => Foldable f => f a -> Maybe a
pmeet :: Eq a => Maximal a => Foldable f => f a -> Maybe a
pmeet = foldM pmin maximal

sign :: Eq a => Num a => Prd a => a -> Maybe Ordering
Expand Down Expand Up @@ -416,11 +416,11 @@ instance Prd All where
instance (Eq a, Semigroup a) => Prd (S.First a) where
(<~) = (==)
instance Ord a => Prd (S.Max a) where
pcompare (S.Max x) (S.Max y) = Just $ compare x y
instance Ord a => Prd (S.Maximal a) where
pcompare (S.Maximal x) (S.Maximal y) = Just $ compare x y
instance Ord a => Prd (S.Min a) where
pcompare (S.Min x) (S.Min y) = Just $ compare y x
instance Ord a => Prd (S.Minimal a) where
pcompare (S.Minimal x) (S.Minimal y) = Just $ compare y x
-}

Expand Down Expand Up @@ -496,131 +496,131 @@ instance Prd a => Prd (IntMap.IntMap a) where
instance Prd IntSet.IntSet where
(<~) = IntSet.isSubsetOf


-- Helper type for 'DerivingVia'
newtype Ordered a = Ordered { getOrdered :: a }
deriving ( Eq, Ord, Show, Data, Typeable, Generic, Generic1, Functor, Foldable, Traversable)

instance Ord a => Prd (Ordered a) where
(<~) = (<=)

type Bound a = (Min a, Max a)
-------------------------------------------------------------------------------
-- Minimal
-------------------------------------------------------------------------------

type Bound a = (Minimal a, Maximal a)

-- | Min element of a partially ordered set.
-- | Minimal element of a partially ordered set.
--
-- \( \forall x: x \ge minimal \)
--
-- This means that 'minimal' must be comparable to all values in /a/.
--
class Prd a => Min a where
class Prd a => Minimal a where
minimal :: a

instance Min () where minimal = ()
instance Minimal () where minimal = ()

instance Min Natural where minimal = 0
instance Minimal Natural where minimal = 0

instance Min Bool where minimal = minBound
instance Minimal Bool where minimal = minBound

instance Min Ordering where minimal = minBound
instance Minimal Ordering where minimal = minBound

instance Min Int where minimal = minBound
instance Minimal Int where minimal = minBound

instance Min Int8 where minimal = minBound
instance Minimal Int8 where minimal = minBound

instance Min Int16 where minimal = minBound
instance Minimal Int16 where minimal = minBound

instance Min Int32 where minimal = minBound
instance Minimal Int32 where minimal = minBound

instance Min Int64 where minimal = minBound
instance Minimal Int64 where minimal = minBound

instance Min Word where minimal = minBound
instance Minimal Word where minimal = minBound

instance Min Word8 where minimal = minBound
instance Minimal Word8 where minimal = minBound

instance Min Word16 where minimal = minBound
instance Minimal Word16 where minimal = minBound

instance Min Word32 where minimal = minBound
instance Minimal Word32 where minimal = minBound

instance Min Word64 where minimal = minBound
instance Minimal Word64 where minimal = minBound

instance Prd a => Min (IntMap.IntMap a) where
instance Prd a => Minimal (IntMap.IntMap a) where
minimal = IntMap.empty

instance Ord a => Min (Set.Set a) where
instance Ord a => Minimal (Set.Set a) where
minimal = Set.empty

instance (Ord k, Prd a) => Min (Map.Map k a) where
instance (Ord k, Prd a) => Minimal (Map.Map k a) where
minimal = Map.empty

instance (Min a, Min b) => Min (a, b) where
instance (Minimal a, Minimal b) => Minimal (a, b) where
minimal = (minimal, minimal)

instance (Min a, Prd b) => Min (Either a b) where
instance (Minimal a, Prd b) => Minimal (Either a b) where
minimal = Left minimal

instance Prd a => Min (Maybe a) where
instance Prd a => Minimal (Maybe a) where
minimal = Nothing

instance Max a => Min (Down a) where
instance Maximal a => Minimal (Down a) where
minimal = Down maximal

-- | Max element of a partially ordered set.
-------------------------------------------------------------------------------
-- Maximal
-------------------------------------------------------------------------------

-- | Maximal element of a partially ordered set.
--
-- \( \forall x: x \le maximal \)
--
-- This means that 'maximal' must be comparable to all values in /a/.
--
class Prd a => Max a where
class Prd a => Maximal a where
maximal :: a

instance Max () where maximal = ()
instance Maximal () where maximal = ()

instance Max Bool where maximal = maxBound
instance Maximal Bool where maximal = maxBound

instance Max Ordering where maximal = maxBound
instance Maximal Ordering where maximal = maxBound

instance Max Int where maximal = maxBound
instance Maximal Int where maximal = maxBound

instance Max Int8 where maximal = maxBound
instance Maximal Int8 where maximal = maxBound

instance Max Int16 where maximal = maxBound
instance Maximal Int16 where maximal = maxBound

instance Max Int32 where maximal = maxBound
instance Maximal Int32 where maximal = maxBound

instance Max Int64 where maximal = maxBound
instance Maximal Int64 where maximal = maxBound

instance Max Word where maximal = maxBound
instance Maximal Word where maximal = maxBound

instance Max Word8 where maximal = maxBound
instance Maximal Word8 where maximal = maxBound

instance Max Word16 where maximal = maxBound
instance Maximal Word16 where maximal = maxBound

instance Max Word32 where maximal = maxBound
instance Maximal Word32 where maximal = maxBound

instance Max Word64 where maximal = maxBound
instance Maximal Word64 where maximal = maxBound

instance (Max a, Max b) => Max (a, b) where
instance (Maximal a, Maximal b) => Maximal (a, b) where
maximal = (maximal, maximal)

instance (Prd a, Max b) => Max (Either a b) where
instance (Prd a, Maximal b) => Maximal (Either a b) where
maximal = Right maximal

instance Max a => Max (Maybe a) where
instance Maximal a => Maximal (Maybe a) where
maximal = Just maximal

instance Min a => Max (Down a) where
instance Minimal a => Maximal (Down a) where
maximal = Down minimal

{-
instance (Universe a, Prd a) => Prd (k -> a) where
instance Min a => Min (k -> a) where
minimal = const minimal
instance Max a => Max (k -> a) where
maximal = const maximal
-}

-------------------------------------------------------------------------------
-- Iterators
-------------------------------------------------------------------------------

{-# INLINE until #-}
until :: (a -> Bool) -> (a -> a -> Bool) -> (a -> a) -> a -> a
Expand Down
21 changes: 9 additions & 12 deletions src/Data/Prd/Lattice.hs
Original file line number Diff line number Diff line change
Expand Up @@ -143,7 +143,7 @@ class Prd a => Lattice a where
(/\) :: a -> a -> a

-- | Lattice morphism.
fromSubset :: Min a => Set a -> a
fromSubset :: Minimal a => Set a -> a
fromSubset = join

-- | The partial ordering induced by the join-semilattice structure
Expand All @@ -153,10 +153,10 @@ joinLeq x y = x \/ y =~ y
meetLeq :: Lattice a => a -> a -> Bool
meetLeq x y = x /\ y =~ x

join :: (Min a, Lattice a, Foldable f) => f a -> a
join :: (Minimal a, Lattice a, Foldable f) => f a -> a
join = foldr' (\/) minimal

meet :: (Max a, Lattice a, Foldable f) => f a -> a
meet :: (Maximal a, Lattice a, Foldable f) => f a -> a
meet = foldr' (/\) maximal

-- | The join of at a list of join-semilattice elements (of length at least one)
Expand All @@ -170,8 +170,6 @@ meet1 = unMeet . foldMap1 Meet

-- | Birkhoff's self-dual ternary median operation.
--
-- TODO: require a /Dioid/ instance.
--
-- @ median x x y ≡ x @
--
-- @ median x y z ≡ median z x y @
Expand All @@ -183,7 +181,6 @@ meet1 = unMeet . foldMap1 Meet
median :: Lattice a => a -> a -> a -> a
median x y z = (x \/ y) /\ (y \/ z) /\ (z \/ x)


---------------------------------------------------------------------
-- Instances
---------------------------------------------------------------------
Expand Down Expand Up @@ -225,20 +222,20 @@ instance Lattice All where
All a \/ All b = All $ a \/ b
All a /\ All b = All $ a /\ b

instance Min All where
instance Minimal All where
minimal = All False

instance Max All where
instance Maximal All where
maximal = All True

instance Lattice Any where
Any a \/ Any b = Any $ a \/ b
Any a /\ Any b = Any $ a /\ b

instance Min Any where
instance Minimal Any where
minimal = Any False

instance Max Any where
instance Maximal Any where
maximal = Any True

instance Lattice a => Lattice (Down a) where
Expand Down Expand Up @@ -275,7 +272,7 @@ newtype Join a = Join { unJoin :: a }
instance Lattice a => Semigroup (Join a) where
Join a <> Join b = Join (a \/ b)

instance (Lattice a, Min a) => Monoid (Join a) where
instance (Lattice a, Minimal a) => Monoid (Join a) where
mempty = Join minimal
Join a `mappend` Join b = Join (a \/ b)

Expand All @@ -288,6 +285,6 @@ newtype Meet a = Meet { unMeet :: a }
instance Lattice a => Semigroup (Meet a) where
Meet a <> Meet b = Meet (a /\ b)

instance (Lattice a, Max a) => Monoid (Meet a) where
instance (Lattice a, Maximal a) => Monoid (Meet a) where
mempty = Meet maximal
Meet a `mappend` Meet b = Meet (a /\ b)
4 changes: 2 additions & 2 deletions test/Test/Data/Prd.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,8 +16,8 @@ import qualified Hedgehog.Range as R
rw :: Range Word
rw = R.constant 0 100

gen_min :: MonadGen m => m r -> m (Min r)
gen_min g = maybe2Min id <$> G.maybe g
gen_min :: MonadGen m => m r -> m (Minimal r)
gen_min g = maybe2Minimal id <$> G.maybe g

gen_min_plus :: Gen (MinPlus Word)
gen_min_plus = gen_min $ Sum <$> G.word rw
Expand Down

0 comments on commit b4b12e5

Please sign in to comment.