packages feed

numhask 0.13.2.1 → 0.13.3.0

raw patch · 14 files changed

+314/−57 lines, 14 files

Files

ChangeLog.md view
@@ -1,3 +1,12 @@+0.13.3.0+===++- Added `Read` instance for `Polar` in `NumHask.Algebra.Metric`.+- Added `NumHask.Algebra.Tropical` with the `MinPlus` tropical semiring.+- Added `StarSemiring` and `KleeneAlgebra` instances for `Bool`.+- Added `Magma`, `Unital` and `Idempotent` instances for `Bool`.+- Documented `StarSemiring` and `KleeneAlgebra` laws with the Conway equations.+ 0.13.2.1 ===
numhask.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: numhask-version: 0.13.2.1+version: 0.13.3.0 license: BSD-3-Clause license-file: LICENSE copyright: Tony Day (c) 2016@@ -62,7 +62,9 @@     NumHask.Algebra.Lattice     NumHask.Algebra.Metric     NumHask.Algebra.Multiplicative+    NumHask.Algebra.Patterns     NumHask.Algebra.Ring+    NumHask.Algebra.Tropical     NumHask.Data.Complex     NumHask.Data.Integral     NumHask.Data.Positive
src/NumHask.hs view
@@ -36,6 +36,9 @@     InvolutiveRing (..),     two, +    -- * Tropical+    MinPlus (..),+     -- * Field     Field,     ExpField (..),@@ -69,6 +72,7 @@     DivisiveAction (..),     (/|),     Module,+    TrivialAction (..),      -- * Metric     Basis (..),@@ -92,6 +96,7 @@     (+:),     realPart,     imagPart,+    normSquared,      -- * Integral     Integral (..),@@ -104,6 +109,7 @@     odd,     (^^),     (^),+    (^+),      -- * Rational     Ratio (..),@@ -113,6 +119,8 @@     FromRational (..),     reduce,     gcd,+    numerator,+    denominator,      -- * Exceptions     NumHaskException (..),@@ -126,6 +134,7 @@     Module,     MultiplicativeAction (..),     SubtractiveAction (..),+    TrivialAction (..),     (*|),     (+|),     (-|),@@ -191,7 +200,14 @@     StarSemiring (..),     two,   )-import NumHask.Data.Complex (Complex (..), imagPart, realPart, (+:))+import NumHask.Algebra.Tropical (MinPlus (..))+import NumHask.Data.Complex+  ( Complex (..),+    imagPart,+    normSquared,+    realPart,+    (+:),+  ) import NumHask.Data.Integral   ( FromInt,     FromInteger (..),@@ -202,6 +218,7 @@     even,     odd,     (^),+    (^+),     (^^),   ) import NumHask.Data.Rational@@ -210,7 +227,9 @@     Ratio (..),     Rational,     ToRatio (..),+    denominator,     gcd,+    numerator,     reduce,   ) import NumHask.Exception (NumHaskException (..), throw)
src/NumHask/Algebra/Action.hs view
@@ -13,14 +13,15 @@     DivisiveAction (..),     (/|),     Module,+    TrivialAction (..),   ) where  import Data.Kind (Type)-import NumHask.Algebra.Additive (Additive, Subtractive, negate)-import NumHask.Algebra.Multiplicative (Divisive, Multiplicative, recip)+import NumHask.Algebra.Additive (Additive (..), Subtractive (..))+import NumHask.Algebra.Multiplicative (Divisive (..), Multiplicative (..)) import NumHask.Algebra.Ring (Distributive)-import Prelude (flip)+import Prelude (Eq, Ord, flip)  -- | Additive Action --@@ -110,3 +111,23 @@ -- > a *| zero == zero -- > a *| b == b |* a type Module m = (Distributive (Scalar m), MultiplicativeAction m)++-- | An action of a set of numbers on itself+newtype TrivialAction a = TrivialAction+  { getTrivialAction :: a+  }+  deriving (Eq, Ord, Additive, Subtractive, Multiplicative, Divisive)++instance (Additive a) => AdditiveAction (TrivialAction a) where+  type AdditiveScalar (TrivialAction a) = a+  TrivialAction a |+ b = TrivialAction (a + b)++instance (Subtractive a) => SubtractiveAction (TrivialAction a) where+  TrivialAction a |- b = TrivialAction (a - b)++instance (Multiplicative a) => MultiplicativeAction (TrivialAction a) where+  type Scalar (TrivialAction a) = a+  TrivialAction a |* b = TrivialAction (a * b)++instance (Divisive a) => DivisiveAction (TrivialAction a) where+  TrivialAction a |/ b = TrivialAction (a / b)
src/NumHask/Algebra/Group.hs view
@@ -40,6 +40,12 @@ instance (Magma b) => Magma (a -> b) where   f ⊕ g = \a -> f a ⊕ g a +instance Magma Bool where+  a ⊕ b = a || b++instance Unital Bool where+  unit = False+ -- | A Unital Magma is a magma with an --   <https://en.wikipedia.org/wiki/Identity_element identity element> (the --   unit).@@ -115,6 +121,8 @@   Idempotent a  instance (Idempotent b) => Idempotent (a -> b)++instance Idempotent Bool  -- | An <https://en.wikipedia.org/wiki/Abelian_group Abelian Group> is an --   Associative, Unital, Invertible and Commutative Magma . In other words, it
src/NumHask/Algebra/Lattice.hs view
@@ -76,45 +76,45 @@  -- | A join-semilattice with an identity element 'bottom' for '\/'. ----- > x \/ bottom == bottom+-- > x \/ bottom == x class (JoinSemiLattice a) => LowerBounded a where   bottom :: a  -- | A meet-semilattice with an identity element 'top' for '/\'. ----- > x /\ top == top+-- > x /\ top == x class (MeetSemiLattice a) => UpperBounded a where   top :: a  -- | Lattices with both bounds ----- > x /\ bottom == x--- > x \/ top = x+-- > x /\ bottom == bottom+-- > x \/ top == top type BoundedLattice a = (JoinSemiLattice a, MeetSemiLattice a, LowerBounded a, UpperBounded a)  instance JoinSemiLattice Float where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Float where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Double where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Double where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Int where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Int where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Integer where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Integer where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Bool where   (\/) = (||)@@ -123,64 +123,64 @@   (/\) = (&&)  instance JoinSemiLattice Natural where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Natural where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Int8 where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Int8 where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Int16 where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Int16 where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Int32 where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Int32 where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Int64 where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Int64 where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Word where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Word where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Word8 where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Word8 where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Word16 where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Word16 where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Word32 where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Word32 where-  (/\) = max+  (/\) = min  instance JoinSemiLattice Word64 where-  (\/) = min+  (\/) = max  instance MeetSemiLattice Word64 where-  (/\) = max+  (/\) = min  instance LowerBounded Float where   bottom = negInfinity
src/NumHask/Algebra/Metric.hs view
@@ -38,7 +38,7 @@ import NumHask.Algebra.Lattice import NumHask.Algebra.Multiplicative import NumHask.Algebra.Ring-import Prelude (Double, Eq (..), Float, Functor (..), Int, Integer, Show, Word, fromRational)+import Prelude (Double, Eq (..), Float, Functor (..), Int, Integer, Read, Show, Word, fromRational) import Prelude qualified as P  -- $setup@@ -221,7 +221,7 @@ -- -- See [Polar coordinate system](https://en.wikipedia.org/wiki/Polar_coordinate_system) data Polar a = Polar {radial :: a, azimuth :: a}-  deriving (Eq, Show, Generic, Data)+  deriving (Eq, Show, Read, Generic, Data)  instance (Additive a, Multiplicative a) => Basis (Polar a) where   type Mag (Polar a) = a@@ -257,7 +257,7 @@ -- >>> nearZero (epsilon :: EuclideanPair Double) -- True nearZero :: (Epsilon a, Lattice a, Subtractive a) => a -> Bool-nearZero a = epsilon /\ a == epsilon && epsilon /\ negate a == epsilon+nearZero a = a /\ epsilon == a && negate a /\ epsilon == negate a  -- | Approximate equality --
+ src/NumHask/Algebra/Patterns.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}++-- | Patterns for common tests+module NumHask.Algebra.Patterns+  ( pattern Zero,+    pattern One,+    pattern MinusOne,+  )+where++import NumHask.Algebra.Additive+import NumHask.Algebra.Multiplicative+import Prelude (Bool (..), Eq (..), (.))++-- | Enabling pattern matching on zero:+--+-- > isItZero Zero = True+-- > isItZero _    = False+pattern Zero :: forall a. (Eq a, Additive a) => a+pattern Zero <- ((== zero) -> True)++-- | Enabling pattern matching on one:+--+-- > isItOne One = True+-- > isItOne _   = False+pattern One :: forall a. (Eq a, Multiplicative a) => a+pattern One <- ((== one) -> True)++-- | Enabling pattern matching on minus one:+--+-- > isItMinusOne MinusOne = True+-- > isItMinusOne _        = False+--+-- The means of testing (that is, add one, and check if it equals+-- zero) might be surprising. Other, more obvious, methods would+-- result in underflow errors. (For example, we could negate and test+-- if it's equal to one, but that would fail on any nonzero+-- 'Natural'. Similarly, we could test for equality with the negation of+-- one, but that would fail on any 'Natural' whatsoever, since 'negate+-- one' underflows.)+pattern MinusOne :: forall a. (Eq a, Additive a, Multiplicative a) => a+pattern MinusOne <- ((== zero) . (+ one) -> True)
src/NumHask/Algebra/Ring.hs view
@@ -52,9 +52,13 @@ -- > \a -> a * zero == zero type Ring a = (Distributive a, Subtractive a) --- | A <https://en.wikipedia.org/wiki/Semiring#Star_semirings StarSemiring> is a semiring with an additional unary operator (star) satisfying:+-- | A <https://en.wikipedia.org/wiki/Semiring#Star_semirings StarSemiring> is a semiring with a unary star operator satisfying the Conway equations: ----- > \a -> star a == one + a * star a+-- > \a -> star a == one + a * star a                                  -- fixpoint+-- > \a b -> star (a * b) == one + a * star (b * a) * b                -- product-star (sliding)+-- > \a b -> star (a + b) == star (star a * b) * star a                -- sum-star (vanishing)+--+-- These three equations are the doctestable core; they are exactly the sliding and vanishing axioms of a traced category in semiring clothing. class (Distributive a) => StarSemiring a where   {-# MINIMAL star | plus #-} @@ -66,9 +70,26 @@  -- | A <https://en.wikipedia.org/wiki/Kleene_algebra Kleene Algebra> is a Star Semiring with idempotent addition. ----- > a * x + x = a ==> star a * x + x = x--- > x * a + x = a ==> x * star a + x = x+-- Idempotent addition gives a natural order @a <= b ⟺ a + b == b@. In that order, Kozen's induction laws hold as derived facts:+--+-- > a * x + x <= x  ==>  star a * x + x <= x+-- > x * a + x <= x  ==>  x * star a + x <= x+--+-- They are stated here as prose rather than class laws because they involve a partial order and Horn clauses, which do not fit the equational/doctest style of the Conway core. class (StarSemiring a, Idempotent a) => KleeneAlgebra a++instance StarSemiring P.Bool where+  star _ = P.True++instance KleeneAlgebra P.Bool++-- | Conway equations for 'Bool'.+--+-- >>> let a = False; b = True in star (a * b) == one + a * star (b * a) * b+-- True+--+-- >>> let a = False; b = True in star (a + b) == star (star a * b) * star a+-- True  -- | Involutive Ring --
+ src/NumHask/Algebra/Tropical.hs view
@@ -0,0 +1,65 @@+-- | Tropical semirings.+module NumHask.Algebra.Tropical+  ( MinPlus (..),+  )+where++import NumHask.Algebra.Additive (Additive (..))+import NumHask.Algebra.Group (Idempotent, Magma (..))+import NumHask.Algebra.Multiplicative (Multiplicative (..))+import NumHask.Algebra.Ring (KleeneAlgebra, StarSemiring (..))+import Prelude (Double, Eq, Ord, Show, fromInteger)+import Prelude qualified as P++-- $setup+--+-- >>> :m -Prelude+-- >>> :set -XRebindableSyntax+-- >>> import NumHask.Prelude+-- >>> import NumHask.Algebra.Tropical++-- | The min-plus tropical semiring.+--+-- Addition is 'min', multiplication is ordinary addition, the additive unit+-- is positive infinity, and the multiplicative unit is zero.+--+-- >>> MinPlus 3 + MinPlus 2 :: MinPlus Double+-- MinPlus {getMinPlus = 2.0}+--+-- >>> MinPlus 3 * MinPlus 2 :: MinPlus Double+-- MinPlus {getMinPlus = 5.0}+newtype MinPlus a = MinPlus+  { getMinPlus :: a+  }+  deriving (Eq, Ord, Show)++instance Additive (MinPlus Double) where+  MinPlus a + MinPlus b = MinPlus (P.min a b)+  zero = MinPlus (1 P./ 0)++instance Multiplicative (MinPlus Double) where+  MinPlus a * MinPlus b = MinPlus (a P.+ b)+  one = MinPlus 0++instance Magma (MinPlus Double) where+  a ⊕ b = a + b++instance Idempotent (MinPlus Double)++-- | Star is zero in a min-plus semiring: the cheapest repeated traversal is+-- to stay put.+--+-- >>> star (MinPlus 2 :: MinPlus Double)+-- MinPlus {getMinPlus = 0.0}+--+-- Conway equations for 'MinPlus Double'.+--+-- >>> let a = MinPlus 2 :: MinPlus Double; b = MinPlus 3 :: MinPlus Double in star (a * b) == one + a * star (b * a) * b+-- True+--+-- >>> let a = MinPlus 2 :: MinPlus Double; b = MinPlus 3 :: MinPlus Double in star (a + b) == star (star a * b) * star a+-- True+instance StarSemiring (MinPlus Double) where+  star _ = one++instance KleeneAlgebra (MinPlus Double)
src/NumHask/Data/Complex.hs view
@@ -8,6 +8,7 @@     (+:),     realPart,     imagPart,+    normSquared,   ) where @@ -131,3 +132,8 @@   ceiling (Complex (x, y)) = Complex (ceiling x, ceiling y)   floor (Complex (x, y)) = Complex (floor x, floor y)   truncate (Complex (x, y)) = Complex (truncate x, truncate y)++-- | The squared norm: frequently useful, and doesn't require the+-- ability to take square roots.+normSquared :: (Distributive a) => Complex a -> a+normSquared (Complex (x, y)) = x * x + y * y
src/NumHask/Data/Integral.hs view
@@ -10,6 +10,7 @@     odd,     (^^),     (^),+    (^+),   ) where @@ -421,6 +422,10 @@ instance FromInteger Word64 where   fromInteger = P.fromInteger +deriving instance (FromInteger a) => FromInteger (Sum a)++deriving instance (FromInteger a) => FromInteger (Product a)+ infixr 8 ^^  -- | raise a number to an 'Integral' power@@ -464,3 +469,32 @@ (^) ::   (Divisive a) => a -> Int -> a (^) x n = x ^^ n++infixr 8 ^+++-- | raise a number to a non-negative 'Natural' power.+--+-- Unlike '(^^)' and '(^)', this does not require 'Divisive' or 'Subtractive'+-- constraints, so it works for unsigned types such as 'Natural' and 'Word64'.+--+-- >>> 2 ^+ 3+-- 8+--+-- >>> 2 ^+ 0+-- 1+(^+) ::+  (Multiplicative a) => a -> Natural -> a+x0 ^+ y0 =+  case compare y0 zero of+    EQ -> one+    GT -> f x0 y0+    LT -> P.error "(^+): negative exponent"+  where+    f x y+      | even y = f (x * x) (y `quot` two)+      | y P.== one = x+      | P.otherwise = g (x * x) (y `quot` two) x+    g x y z+      | even y = g (x * x) (y `quot` two) z+      | y P.== one = x * z+      | P.otherwise = g (x * x) (y `quot` two) (x * z)
src/NumHask/Data/Positive.hs view
@@ -28,6 +28,7 @@ import NumHask.Data.Integral import NumHask.Data.Rational import NumHask.Data.Wrapped+import Numeric.Natural (Natural, minusNaturalMaybe) import Prelude (Eq, Ord, Show) import Prelude qualified as P @@ -88,7 +89,7 @@     )     via (Wrapped a) -instance (MeetSemiLattice a, Integral a) => FromIntegral (Positive a) a where+instance (JoinSemiLattice a, Integral a) => FromIntegral (Positive a) a where   fromIntegral a = positive a  instance (FromIntegral a b) => FromIntegral (Positive a) b where@@ -124,8 +125,8 @@ -- -- >>> positive (-1) -- UnsafePositive {unPositive = 0}-positive :: (Additive a, MeetSemiLattice a) => a -> Positive a-positive a = UnsafePositive (a /\ zero)+positive :: (Additive a, JoinSemiLattice a) => a -> Positive a+positive a = UnsafePositive (a \/ zero)  -- | Unsafe constructor. --@@ -139,9 +140,9 @@ -- >>> maybePositive (-one) -- Nothing maybePositive :: (Additive a, MeetSemiLattice a) => a -> Maybe (Positive a)-maybePositive a = bool Nothing (Just (UnsafePositive a)) (a `meetLeq` zero)+maybePositive a = bool Nothing (Just (UnsafePositive a)) (zero `meetLeq` a) -instance (Subtractive a, MeetSemiLattice a) => Monus (Positive a) where+instance (Subtractive a, JoinSemiLattice a) => Monus (Positive a) where   (UnsafePositive a) ∸ (UnsafePositive b) = positive (a - b)  -- | A field but with truncated subtraction.@@ -161,8 +162,25 @@    infixl 6 ∸   (∸) :: a -> a -> a-  default (∸) :: (LowerBounded a, MeetSemiLattice a, Subtractive a) => a -> a -> a-  a ∸ b = bottom /\ (a - b)+  default (∸) :: (LowerBounded a, Subtractive a) => a -> a -> a+  a ∸ b = bottom \/ (a - b)++-- | A newtype wrapper intended for defining Monus instances by:+-- "x ∸ y = if x < y then zero else x - y"+newtype MonusFromOrd a = MonusFromOrd a+  deriving (Eq, Ord, Additive, Subtractive)++instance (Ord a, Subtractive a) => Monus (MonusFromOrd a) where+  x ∸ y+    | x P.< y = zero+    | P.otherwise = x - y++-- | It appears that Haskell doesn't have any built in truncated+-- subtraction operation for Word+deriving via MonusFromOrd P.Word instance Monus P.Word++instance Monus Natural where+  x ∸ y = fromMaybe 0 (minusNaturalMaybe x y)  -- | Truncated addition --
src/NumHask/Data/Rational.hs view
@@ -10,6 +10,8 @@     FromRational (..),     reduce,     gcd,+    numerator,+    denominator,   ) where @@ -41,7 +43,13 @@ -- | Ratio of two integers type Rational = Ratio Integer -instance (P.Eq a, Subtractive a, EndoBased a, Absolute a, Integral a) => P.Eq (Ratio a) where+numerator :: Ratio a -> a+numerator (a :% _) = a++denominator :: Ratio a -> a+denominator (_ :% a) = a++instance (P.Eq a, P.Ord a, Subtractive a, EndoBased a, Absolute a, Integral a) => P.Eq (Ratio a) where   a@(xa :% ya) == b@(xb :% yb)     | isRNaN a P.|| isRNaN b = P.False     | xa == zero P.&& xb == zero = P.True@@ -82,7 +90,7 @@   Divisive (Ratio a)   where   recip (x :% y)-    | signum x P.== negate one = negate y :% negate x+    | x P.< zero = negate y :% negate x     | P.otherwise = y :% x  instance (P.Ord a, EndoBased a, Absolute a, ToInt a, Integral a, Ring a) => QuotientField (Ratio a) where@@ -100,13 +108,16 @@   magnitude (n :% d) = abs n :% abs d  instance (P.Ord a, Integral a, EndoBased a, Subtractive a) => JoinSemiLattice (Ratio a) where-  (\/) = P.min+  (\/) = P.max  instance (P.Ord a, Integral a, EndoBased a, Subtractive a) => MeetSemiLattice (Ratio a) where-  (/\) = P.max+  (/\) = P.min  instance (P.Ord a, EndoBased a, Integral a, Ring a) => Epsilon (Ratio a) +instance (FromInteger a, Multiplicative a) => FromInteger (Ratio a) where+  fromInteger x = fromInteger x :% one+ instance (FromIntegral a b, Multiplicative a) => FromIntegral (Ratio a) b where   fromIntegral x = fromIntegral x :% one @@ -208,7 +219,7 @@ -- -- prop> \a b -> reduce a b == a :% b || b == zero reduce ::-  (P.Eq a, Subtractive a, EndoBased a, Integral a) => a -> a -> Ratio a+  (P.Ord a, Subtractive a, EndoBased a, Integral a) => a -> a -> Ratio a reduce x y   | x P.== zero P.&& y P.== zero = zero :% zero   | z P.== zero = one :% zero@@ -216,7 +227,7 @@   where     z = gcd x y     n % d-      | signum d P.== negate one = negate n :% negate d+      | d P.< zero = negate n :% negate d       | P.otherwise = n :% d  -- | @'gcd' x y@ is the non-negative factor of both @x@ and @y@ of which