diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,12 @@ +0.8.0 +===== + +* GHC 9.0.1 support +* Removed protolude and replaced it with prelude +* Removed NumHask.Data.Positive, NumHask.Data.LogFloat, NumHask.Data.Wrapper +* modified project build to cabal +* removed NegativeLiterals recommendation. + 0.7.0 ===== @@ -14,7 +23,6 @@ * Added doctests and laws * Improved haddocks * Made (^) a monomorphic `a -> Int -> a` and accept negative Ints - 0.6.0 diff --git a/numhask.cabal b/numhask.cabal --- a/numhask.cabal +++ b/numhask.cabal @@ -1,10 +1,10 @@ cabal-version: 2.4 name: numhask -version: 0.7.1.0 +version: 0.8.0.0 synopsis: A numeric class hierarchy. description: - This package provides numeric classes alternate to the prelude specified in [haskell98](https://www.haskell.org/onlinereport/standard-prelude.html). + This package provides alternative numeric classes over Prelude. . The numeric class constellation looks somewhat like: . @@ -12,7 +12,6 @@ . == Usage . - >>> {-# LANGUAGE NegativeLiterals #-} >>> {-# LANGUAGE RebindableSyntax #-} >>> import NumHask.Prelude . @@ -39,6 +38,8 @@ tested-with: GHC ==8.8.4 || ==8.10.2 + || ==8.10.4 + || ==9.0.1 extra-doc-files: other/*.svg @@ -66,29 +67,20 @@ -fwrite-ide-info -hiedir=.hie build-depends: - base >=4.7 && <5, - protolude >=0.3 && <0.4, - bifunctors >= 5.5 && < 5.6, - mmorph >= 1.1 && < 1.2, - random >= 1.2 && < 1.3, - transformers >= 0.5 && < 0.6, - text >= 1.2 && < 1.3, + base >=4.7 && <5 exposed-modules: NumHask NumHask.Algebra.Additive NumHask.Algebra.Field NumHask.Algebra.Group NumHask.Algebra.Lattice + NumHask.Algebra.Metric NumHask.Algebra.Module NumHask.Algebra.Multiplicative NumHask.Algebra.Ring - NumHask.Analysis.Metric NumHask.Data.Complex NumHask.Data.Integral - NumHask.Data.LogField - NumHask.Data.Positive NumHask.Data.Rational - NumHask.Data.Wrapped NumHask.Exception NumHask.Prelude other-modules: @@ -102,8 +94,7 @@ build-depends: QuickCheck >= 2.13 && < 2.15, base >=4.7 && <5, - doctest >= 0.16 && < 0.18, - numhask, + doctest >= 0.18 && < 0.19 default-language: Haskell2010 ghc-options: -Wall diff --git a/src/NumHask.hs b/src/NumHask.hs --- a/src/NumHask.hs +++ b/src/NumHask.hs @@ -27,12 +27,10 @@ module NumHask.Algebra.Module, module NumHask.Algebra.Multiplicative, module NumHask.Algebra.Ring, - module NumHask.Analysis.Metric, + module NumHask.Algebra.Metric, module NumHask.Data.Complex, module NumHask.Data.Integral, - module NumHask.Data.LogField, module NumHask.Data.Rational, - module NumHask.Data.Positive, module NumHask.Exception, ) where @@ -44,18 +42,15 @@ import NumHask.Algebra.Module import NumHask.Algebra.Multiplicative import NumHask.Algebra.Ring -import NumHask.Analysis.Metric +import NumHask.Algebra.Metric import NumHask.Data.Complex import NumHask.Data.Integral -import NumHask.Data.LogField -import NumHask.Data.Positive import NumHask.Data.Rational import NumHask.Exception -- $setup -- -- >>> :set -XRebindableSyntax --- >>> :set -XNegativeLiterals -- >>> import NumHask.Prelude -- >>> 1+1 -- 2 @@ -98,26 +93,6 @@ -- -- The effect of [ExtendedDefaultRules](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/ghci.html#extension-ExtendedDefaultRules) in ghci or switched on as an extension also need to be understood. It can lead to unusual interactions with numerics and strange error messages at times because it adds @()@ and @[]@ to the start of the type defaulting list. -- --- == Negatives --- --- Without [NegativeLiterals](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/negative_literals.html), GHC and Haskell often reads a negative as subtraction rather than a minus. --- --- > :set -XNoNegativeLiterals --- > :t Point 1 -2 --- Point 1 -2 --- :: (Subtractive (Point a), FromInteger a, --- FromInteger (a -> Point a)) => --- a -> Pair a --- ... --- --- > :set -XNegativeLiterals --- > :t Point 1 -2 --- Point 1 -2 :: FromInteger a => Point a --- --- > Point 1 -2 --- Point 1 -2 --- --- [LexicalNegation](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/lexical_negation.html) is coming soon as a valid replacement for NegativeLiterals and will tighten things up further. -- $overview -- numhask is largely a set of classes that can replace the 'GHC.Num.Num' class and it's descendents. Principles that have guided design include: @@ -176,9 +151,9 @@ -- > -- or @1@ (positive). -- > signum :: a -> a -- --- 'abs' is a function in the 'NumHask.Analysis.Metric.Signed' class. The concept of an absolute value can also include situations where the domain and codomain are different, and 'norm' as a function in the 'NumHask.Analysis.Metric.Norm' class is supplied for these cases. +-- 'abs' is a function in the 'NumHask.Algebra.Metric.Signed' class. The concept of an absolute value can also include situations where the domain and codomain are different, and 'norm' as a function in the 'NumHask.Algebra.Metric.Norm' class is supplied for these cases. -- --- 'NumHask.Analysis.Metric.sign' replaces 'GHC.Num.signum', because signum is simply a naming crime. 'NumHask.Analysis.Metric.basis' can also be seen as a generalisation of sign. +-- 'NumHask.Algebra.Metric.sign' replaces 'GHC.Num.signum', because signum is simply a naming crime. 'NumHask.Algebra.Metric.basis' can also be seen as a generalisation of sign. -- -- > -- | Conversion from an 'Integer'. -- > -- An integer literal represents the application of the function @@ -199,6 +174,3 @@ -- 'GHC.Float.Floating' is split into 'ExpField' and 'TrigField' -- -- 'GHC.Float.RealFloat' is not attempted. Life is too short. - --- $backend --- NumHask imports [protolude](https://hackage.haskell.org/package/protolude) as a base prelude with some minor tweaks. diff --git a/src/NumHask/Algebra/Metric.hs b/src/NumHask/Algebra/Metric.hs new file mode 100644 --- /dev/null +++ b/src/NumHask/Algebra/Metric.hs @@ -0,0 +1,292 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# OPTIONS_GHC -Wall #-} + +-- | Metric classes +module NumHask.Algebra.Metric + ( Signed (..), + Norm (..), + distance, + Direction (..), + Polar (..), + polar, + coord, + Epsilon (..), + (~=), + ) +where + +import Data.Bool (bool) +import Data.Int (Int16, Int32, Int64, Int8) +import Data.Word (Word16, Word32, Word64, Word8) +import GHC.Generics (Generic) +import GHC.Natural (Natural (..)) +import NumHask.Algebra.Additive +import NumHask.Algebra.Lattice +import NumHask.Algebra.Module +import NumHask.Algebra.Multiplicative +import Prelude hiding + ( Bounded (..), + Integral (..), + negate, + (*), + (-), + ) +import qualified Prelude as P + +-- | 'signum' from base is not an operator name in numhask and is replaced by 'sign'. Compare with 'Norm' where there is a change in codomain. +-- +-- > abs a * sign a == a +-- +-- abs zero == zero, so any value for sign zero is ok. We choose lawful neutral: +-- +-- > sign zero == zero +class + (Additive a, Multiplicative a) => + Signed a + where + sign :: a -> a + abs :: a -> a + +instance Signed Double where + sign a = + case compare a zero of + EQ -> zero + GT -> one + LT -> negate one + abs = P.abs + +instance Signed Float where + sign a = + case compare a zero of + EQ -> zero + GT -> one + LT -> negate one + abs = P.abs + +instance Signed Int where + sign a = + case compare a zero of + EQ -> zero + GT -> one + LT -> negate one + abs = P.abs + +instance Signed Integer where + sign a = + case compare a zero of + EQ -> zero + GT -> one + LT -> negate one + abs = P.abs + +instance Signed Natural where + sign a = + case compare a zero of + EQ -> zero + GT -> one + LT -> negate one + abs = id + +instance Signed Int8 where + sign a = + case compare a zero of + EQ -> zero + GT -> one + LT -> negate one + abs = P.abs + +instance Signed Int16 where + sign a = + case compare a zero of + EQ -> zero + GT -> one + LT -> negate one + abs = P.abs + +instance Signed Int32 where + sign a = + case compare a zero of + EQ -> zero + GT -> one + LT -> negate one + abs = P.abs + +instance Signed Int64 where + sign a = + case compare a zero of + EQ -> zero + GT -> one + LT -> negate one + abs = P.abs + +instance Signed Word where + sign a = bool one zero (a == zero) + abs = P.abs + +instance Signed Word8 where + sign a = bool one zero (a == zero) + abs = P.abs + +instance Signed Word16 where + sign a = bool one zero (a == zero) + abs = P.abs + +instance Signed Word32 where + sign a = bool one zero (a == zero) + abs = P.abs + +instance Signed Word64 where + sign a = bool one zero (a == zero) + abs = P.abs + +-- | Norm is a slight generalisation of Signed. The class has the same shape but allows the codomain to be different to the domain. +-- +-- > norm a >= zero +-- > norm zero == zero +-- > a == norm a .* basis a +-- > norm (basis a) == one +class (Additive a, Multiplicative b, Additive b) => Norm a b | a -> b where + -- | or length, or ||v|| + norm :: a -> b + -- | or direction, or v-hat + basis :: a -> a + +instance Norm Double Double where + norm = P.abs + basis = P.signum + +instance Norm Float Float where + norm = P.abs + basis = P.signum + +instance Norm Int Int where + norm = P.abs + basis = P.signum + +instance Norm Integer Integer where + norm = P.abs + basis = P.signum + +instance Norm Natural Natural where + norm = P.abs + basis = P.signum + +instance Norm Int8 Int8 where + norm = P.abs + basis = P.signum + +instance Norm Int16 Int16 where + norm = P.abs + basis = P.signum + +instance Norm Int32 Int32 where + norm = P.abs + basis = P.signum + +instance Norm Int64 Int64 where + norm = P.abs + basis = P.signum + +instance Norm Word Word where + norm = P.abs + basis = P.signum + +instance Norm Word8 Word8 where + norm = P.abs + basis = P.signum + +instance Norm Word16 Word16 where + norm = P.abs + basis = P.signum + +instance Norm Word32 Word32 where + norm = P.abs + basis = P.signum + +instance Norm Word64 Word64 where + norm = P.abs + basis = P.signum + +-- | Distance, which combines the Subtractive notion of difference, with Norm. +-- +-- > distance a b >= zero +-- > distance a a == zero +-- > distance a b .* basis (a - b) == a - b +distance :: (Norm a b, Subtractive a) => a -> a -> b +distance a b = norm (a - b) + +-- | Convert between a "co-ordinated" or "higher-kinded" number and representations of an angle. Typically thought of as polar co-ordinate conversion. +-- +-- See [Polar coordinate system](https://en.wikipedia.org/wiki/Polar_coordinate_system) +-- +-- > ray . angle == basis +-- > norm (ray x) == one +class (Additive coord, Multiplicative coord, Additive dir, Multiplicative dir) => Direction coord dir | coord -> dir where + angle :: coord -> dir + ray :: dir -> coord + +-- | Something that has a magnitude and a direction. +data Polar mag dir = Polar {magnitude :: !mag, direction :: !dir} + deriving (Eq, Show, Generic) + +-- | Convert from a number to a Polar. +polar :: (Norm coord mag, Direction coord dir) => coord -> Polar mag dir +polar z = Polar (norm z) (angle z) + +-- | Convert from a Polar to a (coordinated aka higher-kinded) number. +coord :: (MultiplicativeAction coord mag, Direction coord dir) => Polar mag dir -> coord +coord (Polar m d) = m .* ray d + +-- | A small number, especially useful for approximate equality. +class + (Eq a, Additive a, Subtractive a, MeetSemiLattice a) => + Epsilon a + where + epsilon :: a + epsilon = zero + + nearZero :: a -> Bool + nearZero a = epsilon `meetLeq` a && epsilon `meetLeq` negate a + + aboutEqual :: a -> a -> Bool + aboutEqual a b = nearZero $ a - b + +infixl 4 ~= + +-- | About equal. +(~=) :: (Epsilon a) => a -> a -> Bool +(~=) = aboutEqual + +-- | 1e-14 +instance Epsilon Double where + epsilon = 1e-14 + +-- | 1e-6 +instance Epsilon Float where + epsilon = 1e-6 + +-- | 0 +instance Epsilon Int + +instance Epsilon Integer + +instance Epsilon Int8 + +instance Epsilon Int16 + +instance Epsilon Int32 + +instance Epsilon Int64 + +instance Epsilon Word + +instance Epsilon Word8 + +instance Epsilon Word16 + +instance Epsilon Word32 + +instance Epsilon Word64 diff --git a/src/NumHask/Analysis/Metric.hs b/src/NumHask/Analysis/Metric.hs deleted file mode 100644 --- a/src/NumHask/Analysis/Metric.hs +++ /dev/null @@ -1,286 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# OPTIONS_GHC -Wall #-} - --- | Metric classes -module NumHask.Analysis.Metric - ( Signed (..), - Norm (..), - distance, - Direction (..), - Polar (..), - polar, - coord, - Epsilon (..), - (~=), - ) -where - -import Data.Bool (bool) -import Data.Int (Int16, Int32, Int64, Int8) -import Data.Word (Word16, Word32, Word64, Word8) -import GHC.Generics (Generic) -import GHC.Natural (Natural (..)) -import NumHask.Algebra.Additive -import NumHask.Algebra.Lattice -import NumHask.Algebra.Module -import NumHask.Algebra.Multiplicative -import Prelude hiding - ( Bounded (..), - Integral (..), - negate, - (*), - (-), - ) -import qualified Prelude as P - --- | 'signum' from base is not an operator name in numhask and is replaced by 'sign'. Compare with 'Norm' where there is a change in codomain --- --- > abs a * sign a == a -class - (Additive a, Multiplicative a) => - Signed a - where - sign :: a -> a - abs :: a -> a - -instance Signed Double where - sign a = - case compare a zero of - EQ -> zero - GT -> one - LT -> negate one - abs = P.abs - -instance Signed Float where - sign a = - case compare a zero of - EQ -> zero - GT -> one - LT -> negate one - abs = P.abs - -instance Signed Int where - sign a = - case compare a zero of - EQ -> zero - GT -> one - LT -> negate one - abs = P.abs - -instance Signed Integer where - sign a = - case compare a zero of - EQ -> zero - GT -> one - LT -> negate one - abs = P.abs - -instance Signed Natural where - sign a = - case compare a zero of - EQ -> zero - GT -> one - LT -> negate one - abs = id - -instance Signed Int8 where - sign a = - case compare a zero of - EQ -> zero - GT -> one - LT -> negate one - abs = P.abs - -instance Signed Int16 where - sign a = - case compare a zero of - EQ -> zero - GT -> one - LT -> negate one - abs = P.abs - -instance Signed Int32 where - sign a = - case compare a zero of - EQ -> zero - GT -> one - LT -> negate one - abs = P.abs - -instance Signed Int64 where - sign a = - case compare a zero of - EQ -> zero - GT -> one - LT -> negate one - abs = P.abs - -instance Signed Word where - sign a = bool one zero (a == zero) - abs = P.abs - -instance Signed Word8 where - sign a = bool one zero (a == zero) - abs = P.abs - -instance Signed Word16 where - sign a = bool one zero (a == zero) - abs = P.abs - -instance Signed Word32 where - sign a = bool one zero (a == zero) - abs = P.abs - -instance Signed Word64 where - sign a = bool one zero (a == zero) - abs = P.abs - --- | Norm is a slight generalisation of Signed. The class has the same shape but allows the codomain to be different to the domain. --- --- > norm a >= zero --- > norm zero == zero --- > a == norm a .* basis a --- > norm (basis a) == one -class (Additive a, Multiplicative b, Additive b) => Norm a b | a -> b where - norm :: a -> b - basis :: a -> a - -instance Norm Double Double where - norm = P.abs - basis = P.signum - -instance Norm Float Float where - norm = P.abs - basis = P.signum - -instance Norm Int Int where - norm = P.abs - basis = P.signum - -instance Norm Integer Integer where - norm = P.abs - basis = P.signum - -instance Norm Natural Natural where - norm = P.abs - basis = P.signum - -instance Norm Int8 Int8 where - norm = P.abs - basis = P.signum - -instance Norm Int16 Int16 where - norm = P.abs - basis = P.signum - -instance Norm Int32 Int32 where - norm = P.abs - basis = P.signum - -instance Norm Int64 Int64 where - norm = P.abs - basis = P.signum - -instance Norm Word Word where - norm = P.abs - basis = P.signum - -instance Norm Word8 Word8 where - norm = P.abs - basis = P.signum - -instance Norm Word16 Word16 where - norm = P.abs - basis = P.signum - -instance Norm Word32 Word32 where - norm = P.abs - basis = P.signum - -instance Norm Word64 Word64 where - norm = P.abs - basis = P.signum - --- | Distance, which combines the Subtractive notion of difference, with Norm. --- --- > distance a b >= zero --- > distance a a == zero --- > distance a b .* basis (a - b) == a - b -distance :: (Norm a b, Subtractive a) => a -> a -> b -distance a b = norm (a - b) - --- | Convert between a "co-ordinated" or "higher-kinded" number and representations of an angle. Typically thought of as polar co-ordinate conversion. --- --- See [Polar coordinate system](https://en.wikipedia.org/wiki/Polar_coordinate_system) --- --- > ray . angle == basis --- > norm (ray x) == 1 -class (Additive coord, Multiplicative coord, Additive dir, Multiplicative dir) => Direction coord dir | coord -> dir where - angle :: coord -> dir - ray :: dir -> coord - --- | Something that has a magnitude and a direction. -data Polar mag dir = Polar {magnitude :: !mag, direction :: !dir} - deriving (Eq, Show, Generic) - --- | Convert from a number to a Polar. -polar :: (Norm coord mag, Direction coord dir) => coord -> Polar mag dir -polar z = Polar (norm z) (angle z) - --- | Convert from a Polar to a (coordinated aka higher-kinded) number. -coord :: (MultiplicativeAction coord mag, Direction coord dir) => Polar mag dir -> coord -coord (Polar m d) = m .* ray d - --- | A small number, especially useful for approximate equality. -class - (Eq a, Additive a, Subtractive a, MeetSemiLattice a) => - Epsilon a - where - epsilon :: a - epsilon = zero - - nearZero :: a -> Bool - nearZero a = epsilon `meetLeq` a && epsilon `meetLeq` negate a - - aboutEqual :: a -> a -> Bool - aboutEqual a b = nearZero $ a - b - -infixl 4 ~= - --- | About equal. -(~=) :: (Epsilon a) => a -> a -> Bool -(~=) = aboutEqual - --- | 1e-14 -instance Epsilon Double where - epsilon = 1e-14 - --- | 1e-6 -instance Epsilon Float where - epsilon = 1e-6 - --- | 0 -instance Epsilon Int - -instance Epsilon Integer - -instance Epsilon Int8 - -instance Epsilon Int16 - -instance Epsilon Int32 - -instance Epsilon Int64 - -instance Epsilon Word - -instance Epsilon Word8 - -instance Epsilon Word16 - -instance Epsilon Word32 - -instance Epsilon Word64 diff --git a/src/NumHask/Data/Complex.hs b/src/NumHask/Data/Complex.hs --- a/src/NumHask/Data/Complex.hs +++ b/src/NumHask/Data/Complex.hs @@ -21,7 +21,7 @@ import NumHask.Algebra.Lattice import NumHask.Algebra.Multiplicative import NumHask.Algebra.Ring -import NumHask.Analysis.Metric +import NumHask.Algebra.Metric import NumHask.Data.Integral import Prelude hiding ( Num (..), diff --git a/src/NumHask/Data/Integral.hs b/src/NumHask/Data/Integral.hs --- a/src/NumHask/Data/Integral.hs +++ b/src/NumHask/Data/Integral.hs @@ -23,8 +23,7 @@ import Data.Int (Int16, Int32, Int64, Int8) import Data.Ord import Data.Word (Word, Word16, Word32, Word64, Word8) -import GHC.Natural (Natural (..)) -import GHC.Num (naturalFromInteger) +import GHC.Natural (Natural (..), naturalFromInteger) import NumHask.Algebra.Additive import NumHask.Algebra.Multiplicative import NumHask.Algebra.Ring diff --git a/src/NumHask/Data/LogField.hs b/src/NumHask/Data/LogField.hs deleted file mode 100644 --- a/src/NumHask/Data/LogField.hs +++ /dev/null @@ -1,316 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wall #-} - --- Module : Data.Number.LogFloat --- Copyright : Copyright (c) 2007--2015 wren gayle romano --- License : BSD3 --- Maintainer : wren@community.haskell.org --- Stability : stable --- Portability : portable (with CPP, FFI) --- Link : https://hackage.haskell.org/package/logfloat - --- | A 'Field' in the log domain. --- --- LogField is adapted from [logfloat](https://hackage.haskell.org/package/logfloat) -module NumHask.Data.LogField - ( -- * @LogField@ - LogField (), - logField, - fromLogField, - - -- ** Isomorphism to log-domain - logToLogField, - logFromLogField, - - -- ** Additional operations - accurateSum, - accurateProduct, - pow, - ) -where - -import Data.Data (Data) -import qualified Data.Foldable as F -import GHC.Generics (Generic, Generic1) -import NumHask.Algebra.Additive -import NumHask.Algebra.Field -import NumHask.Algebra.Lattice -import NumHask.Algebra.Multiplicative -import NumHask.Algebra.Ring -import NumHask.Analysis.Metric -import NumHask.Data.Integral -import NumHask.Data.Rational -import Prelude hiding (Num (..), exp, fromIntegral, log, negate) - --- | A @LogField@ is just a 'Field' with a special interpretation. --- The 'LogField' function is presented instead of the constructor, --- in order to ensure semantic conversion. At present the 'Show' --- instance will convert back to the normal-domain, and hence will --- underflow at that point. This behavior may change in the future. --- --- Because 'logField' performs the semantic conversion, we can use --- operators which say what we *mean* rather than saying what we're --- actually doing to the underlying representation. That is, --- equivalences like the following are true[1] thanks to type-class --- overloading: --- --- > logField (p + q) == logField p + logField q --- > logField (p * q) == logField p * logField q --- --- Performing operations in the log-domain is cheap, prevents --- underflow, and is otherwise very nice for dealing with miniscule --- probabilities. However, crossing into and out of the log-domain --- is expensive and should be avoided as much as possible. In --- particular, if you're doing a series of multiplications as in --- @lp * LogField q * LogField r@ it's faster to do @lp * LogField --- (q * r)@ if you're reasonably sure the normal-domain multiplication --- won't underflow; because that way you enter the log-domain only --- once, instead of twice. Also note that, for precision, if you're --- doing more than a few multiplications in the log-domain, you --- should use 'NumHask.Algebra.Multiplication.product' rather than using '(*)' repeatedly. --- --- Even more particularly, you should /avoid addition/ whenever --- possible. Addition is provided because sometimes we need it, and --- the proper implementation is not immediately apparent. However, --- between two @LogField@s addition requires crossing the exp\/log --- boundary twice; with a @LogField@ and a 'Double' it's three --- times, since the regular number needs to enter the log-domain --- first. This makes addition incredibly slow. Again, if you can --- parenthesize to do normal-domain operations first, do it! --- --- [1] That is, true up-to underflow and floating point fuzziness. --- Which is, of course, the whole point of this module. -newtype LogField a - = LogField a - deriving - ( Eq, - Ord, - Read, - Data, - Generic, - Generic1, - Functor, - Foldable, - Traversable - ) - ----------------------------------------------------------------- --- To show it, we want to show the normal-domain value rather than --- the log-domain value. Also, if someone managed to break our --- invariants (e.g. by passing in a negative and noone's pulled on --- the thunk yet) then we want to crash before printing the --- constructor, rather than after. N.B. This means the show will --- underflow\/overflow in the same places as normal doubles since --- we underflow at the @exp@. Perhaps this means we should show the --- log-domain value instead. -instance (ExpField a, Show a) => Show (LogField a) where - showsPrec p (LogField x) = - let y = exp x - in y `seq` showParen (p > 9) (showString "LogField " . showsPrec 11 y) - ----------------------------------------------------------------- - --- | Constructor which does semantic conversion from normal-domain --- to log-domain. Throws errors on negative and NaN inputs. If @p@ --- is non-negative, then following equivalence holds: --- --- > logField p == logToLogField (log p) -logField :: (ExpField a) => a -> LogField a -{-# INLINE [0] logField #-} -logField = LogField . log - --- | Constructor which assumes the argument is already in the --- log-domain. -logToLogField :: a -> LogField a -logToLogField = LogField - --- | Semantically convert our log-domain value back into the --- normal-domain. Beware of overflow\/underflow. The following --- equivalence holds (without qualification): --- --- > fromLogField == exp . logFromLogField -fromLogField :: ExpField a => LogField a -> a -{-# INLINE [0] fromLogField #-} -fromLogField (LogField x) = exp x - --- | Return the log-domain value itself without conversion. -logFromLogField :: LogField a -> a -logFromLogField (LogField x) = x - --- These are our module-specific versions of "log\/exp" and "exp\/log"; --- They do the same things but also have a @LogField@ in between --- the logarithm and exponentiation. In order to ensure these rules --- fire, we have to delay the inlining on two of the four --- con-\/destructors. -{-# RULES -"log/fromLogField" forall x. - log (fromLogField x) = - logFromLogField x -"fromLogField/LogField" forall x. fromLogField (LogField x) = x - #-} - -log1p :: ExpField a => a -> a -{-# INLINE [0] log1p #-} -log1p x = log (one + x) - -expm1 :: (ExpField a) => a -> a -{-# INLINE [0] expm1 #-} -expm1 x = exp x - one - -{-# RULES -"expm1/log1p" forall x. expm1 (log1p x) = x -"log1p/expm1" forall x. log1p (expm1 x) = x - #-} - -instance - (ExpField a, LowerBoundedField a, Ord a) => - Additive (LogField a) - where - x@(LogField x') + y@(LogField y') - | x == zero && y == zero = zero - | x == zero = y - | y == zero = x - | x >= y = LogField (x' + log1p (exp (y' - x'))) - | otherwise = LogField (y' + log1p (exp (x' - y'))) - - zero = LogField negInfinity - -instance - (ExpField a, Ord a, LowerBoundedField a, UpperBoundedField a) => - Subtractive (LogField a) - where - negate x - | x == zero = zero - | otherwise = nan - -instance - (LowerBoundedField a, Eq a) => - Multiplicative (LogField a) - where - (LogField x) * (LogField y) - | x == negInfinity || y == negInfinity = LogField negInfinity - | otherwise = LogField (x + y) - - one = LogField zero - -instance - (LowerBoundedField a, Eq a) => - Divisive (LogField a) - where - recip (LogField x) = LogField $ negate x - -instance - (Ord a, LowerBoundedField a, ExpField a) => - Distributive (LogField a) - -instance (Field (LogField a), ExpField a, LowerBoundedField a, Ord a) => ExpField (LogField a) where - exp (LogField x) = LogField $ exp x - log (LogField x) = LogField $ log x - (**) x (LogField y) = pow x $ exp y - -instance (FromIntegral a b, ExpField a) => FromIntegral (LogField a) b where - fromIntegral = logField . fromIntegral - -instance (ToIntegral a b, ExpField a) => ToIntegral (LogField a) b where - toIntegral = toIntegral . fromLogField - -instance (FromRatio a b, ExpField a) => FromRatio (LogField a) b where - fromRatio = logField . fromRatio - -instance (ToRatio a b, ExpField a) => ToRatio (LogField a) b where - toRatio = toRatio . fromLogField - -instance (Ord a) => JoinSemiLattice (LogField a) where - (\/) = min - -instance (Ord a) => MeetSemiLattice (LogField a) where - (/\) = max - -instance - (Epsilon a, ExpField a, LowerBoundedField a, UpperBoundedField a, Ord a) => - Epsilon (LogField a) - where - epsilon = logField epsilon - nearZero (LogField x) = nearZero $ exp x - aboutEqual (LogField x) (LogField y) = aboutEqual (exp x) (exp y) - -instance (Ord a, ExpField a, LowerBoundedField a, UpperBoundedField a) => Field (LogField a) - -instance - (Ord a, ExpField a, LowerBoundedField a, UpperBoundedField a) => - LowerBoundedField (LogField a) - -instance - (Ord a, ExpField a, LowerBoundedField a, UpperBoundedField a) => - UpperBoundedField (LogField a) - -instance - (Ord a, LowerBoundedField a, UpperBoundedField a, ExpField a) => - Signed (LogField a) - where - sign a - | a == negInfinity = zero - | otherwise = one - abs = id - ----------------------------------------------------------------- - --- | /O(1)/. Compute powers in the log-domain; that is, the following --- equivalence holds (modulo underflow and all that): --- --- > LogField (p ** m) == LogField p `pow` m -pow :: (ExpField a, LowerBoundedField a, Ord a) => LogField a -> a -> LogField a -{-# INLINE pow #-} - -infixr 8 `pow` - -pow x@(LogField x') m - | x == zero && m == zero = LogField zero - | x == zero = x - | otherwise = LogField $ m * x' - --- Some good test cases: --- for @logsumexp == log . accurateSum . map exp@: --- logsumexp[0,1,0] should be about 1.55 --- for correctness of avoiding underflow: --- logsumexp[1000,1001,1000] ~~ 1001.55 == 1000 + 1.55 --- logsumexp[-1000,-999,-1000] ~~ -998.45 == -1000 + 1.55 --- - --- | /O(n)/. Compute the sum of a finite list of 'LogField's, being --- careful to avoid underflow issues. That is, the following --- equivalence holds (modulo underflow and all that): --- --- > LogField . accurateSum == accurateSum . map LogField --- --- /N.B./, this function requires two passes over the input. Thus, --- it is not amenable to list fusion, and hence will use a lot of --- memory when summing long lists. -{-# INLINE accurateSum #-} -accurateSum :: (ExpField a, Foldable f, Ord a) => f (LogField a) -> LogField a -accurateSum xs = LogField (theMax + log theSum) - where - LogField theMax = maximum xs - -- compute @\log \sum_{x \in xs} \exp(x - theMax)@ - theSum = F.foldl' (\acc (LogField x) -> acc + exp (x - theMax)) zero xs - --- | /O(n)/. Compute the product of a finite list of 'LogField's, --- being careful to avoid numerical error due to loss of precision. --- That is, the following equivalence holds (modulo underflow and --- all that): --- --- > LogField . accurateProduct == accurateProduct . map LogField -{-# INLINE accurateProduct #-} -accurateProduct :: (ExpField a, Foldable f) => f (LogField a) -> LogField a -accurateProduct = LogField . fst . F.foldr kahanPlus (zero, zero) - where - kahanPlus (LogField x) (t, c) = - let y = x - c - t' = t + y - c' = (t' - t) - y - in (t', c') diff --git a/src/NumHask/Data/Positive.hs b/src/NumHask/Data/Positive.hs deleted file mode 100644 --- a/src/NumHask/Data/Positive.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# OPTIONS_GHC -Wall #-} - --- | Positive numbers. --- --- Positivity is enforced via the positive constructor -module NumHask.Data.Positive - ( Positive, - positive, - positive_, - ) -where - -import NumHask.Algebra.Additive -import NumHask.Algebra.Field -import NumHask.Algebra.Lattice -import NumHask.Algebra.Multiplicative -import NumHask.Algebra.Ring -import NumHask.Analysis.Metric -import NumHask.Data.Integral -import NumHask.Exception -import qualified Prelude as P - --- | Wrapper for positive numbers. Note that the constructor is not exported. -newtype Positive a = Positive {unPositive :: a} - deriving - ( P.Show, - P.Eq, - P.Ord, - Additive, - Multiplicative, - Divisive, - Distributive, - Field, - ExpField, - TrigField, - Integral, - Signed, - JoinSemiLattice, - MeetSemiLattice, - Epsilon - ) - --- | maybe construct a 'Positive' -positive_ :: (P.Ord a, Additive a) => a -> P.Maybe (Positive a) -positive_ a - | a P.< zero = P.Nothing - | P.otherwise = P.Just (Positive a) - --- | Construct a Positive, throwing an error if the input is negative. -positive :: (P.Ord a, Additive a) => a -> Positive a -positive a - | a P.< zero = throw (NumHaskException "positive number less than zero") - | P.otherwise = Positive a - -instance (P.Ord a, Subtractive a) => Subtractive (Positive a) where - negate (Positive a) - | a P.== zero = Positive zero - | P.otherwise = throw (NumHaskException "negating a positive number") - - (Positive a) - (Positive b) - | a P.>= b = Positive (a - b) - | P.otherwise = throw (NumHaskException "subtracting a larger positive") - -instance - (P.Ord a, QuotientField a P.Integer) => - QuotientField (Positive a) (Positive P.Integer) - where - properFraction (Positive a) = let (i, r) = properFraction a in (Positive i, Positive r) - -instance - (P.Ord a, UpperBoundedField a) => - UpperBoundedField (Positive a) - where - infinity = Positive infinity - -instance (P.Ord a, UpperBoundedField a) => P.Bounded (Positive a) where - minBound = zero - maxBound = infinity diff --git a/src/NumHask/Data/Rational.hs b/src/NumHask/Data/Rational.hs --- a/src/NumHask/Data/Rational.hs +++ b/src/NumHask/Data/Rational.hs @@ -31,7 +31,7 @@ import NumHask.Algebra.Lattice import NumHask.Algebra.Multiplicative import NumHask.Algebra.Ring -import NumHask.Analysis.Metric +import NumHask.Algebra.Metric import NumHask.Data.Integral import Prelude (Int, Integer, Ord (..), Ordering (..), Rational, (.)) import qualified Prelude as P diff --git a/src/NumHask/Data/Wrapped.hs b/src/NumHask/Data/Wrapped.hs deleted file mode 100644 --- a/src/NumHask/Data/Wrapped.hs +++ /dev/null @@ -1,73 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wall #-} - --- | Wrapped numhask instances, useful for derivingvia situations to quickly specifiy a numhask friendly numerical type. -module NumHask.Data.Wrapped - ( Wrapped (..), - ) -where - -import NumHask.Algebra.Additive -import NumHask.Algebra.Field -import NumHask.Algebra.Group -import NumHask.Algebra.Lattice -import NumHask.Algebra.Multiplicative -import NumHask.Algebra.Ring -import NumHask.Analysis.Metric -import NumHask.Data.Integral -import NumHask.Data.Rational -import qualified Prelude as P - --- | Wrapped numeric instances -newtype Wrapped a = Wrapped {unWrapped :: a} - deriving - ( P.Show, - P.Eq, - P.Ord, - Magma, - Idempotent, - Additive, - Subtractive, - Multiplicative, - Divisive, - Distributive, - Ring, - InvolutiveRing, - StarSemiring, - KleeneAlgebra, - Field, - ExpField, - TrigField, - Integral, - Signed, - MeetSemiLattice, - JoinSemiLattice, - BoundedJoinSemiLattice, - BoundedMeetSemiLattice, - Epsilon, - UpperBoundedField, - LowerBoundedField - ) - -instance - (P.Ord a, QuotientField a P.Integer) => - QuotientField (Wrapped a) (Wrapped P.Integer) - where - properFraction (Wrapped a) = let (i, r) = properFraction a in (Wrapped i, Wrapped r) - -instance (FromIntegral a b) => FromIntegral (Wrapped a) b where - fromIntegral a = Wrapped (fromIntegral a) - -instance (ToIntegral a b) => ToIntegral (Wrapped a) b where - toIntegral (Wrapped a) = toIntegral a - -instance (FromRatio a b) => FromRatio (Wrapped a) b where - fromRatio a = Wrapped (fromRatio a) - -instance (ToRatio a b) => ToRatio (Wrapped a) b where - toRatio (Wrapped a) = toRatio a diff --git a/src/NumHask/Prelude.hs b/src/NumHask/Prelude.hs --- a/src/NumHask/Prelude.hs +++ b/src/NumHask/Prelude.hs @@ -1,9 +1,8 @@ -{-# LANGUAGE NegativeLiterals #-} {-# LANGUAGE RebindableSyntax #-} {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_HADDOCK prune #-} --- | A numeric prelude, composed by splicing numhask modules with [protolude](https://hackage.haskell.org/package/protolude), together with a few minor tweaks and additions. +-- | A prelude composed by overlaying numhask on Prelude, together with a few minor tweaks needed for RebindableSyntax. module NumHask.Prelude ( -- * numhask exports module NumHask.Algebra.Additive, @@ -13,49 +12,34 @@ module NumHask.Algebra.Module, module NumHask.Algebra.Multiplicative, module NumHask.Algebra.Ring, - module NumHask.Analysis.Metric, + module NumHask.Algebra.Metric, module NumHask.Data.Complex, module NumHask.Data.Integral, - module NumHask.Data.LogField, module NumHask.Data.Rational, - module NumHask.Data.Positive, module NumHask.Exception, -- * rebindables -- $rebindables fromString, - fail, ifThenElse, fromList, fromListN, - -- * extras - -- $extras - Category (..), - pack, - unpack, - module Data.Bifunctor, - module Data.Biapplicative, - module Control.Monad.Morph, - module Data.Functor.Constant, - module System.Random, - module System.Random.Stateful, Natural (..), - -- * protolude - -- $protolude - module Protolude, + -- * Modules you can't live without + module Data.Bool, + module Data.Kind, + module GHC.Generics, + module Prelude, + module Data.Foldable, + module Data.Traversable, + module Data.Semigroup, + module Data.Maybe, + ) where -import Control.Category (Category (..)) -import Control.Monad (fail) -import Control.Monad.Morph -import Data.Biapplicative -import Data.Bifunctor -import Data.Functor.Constant -import Data.String -import Data.Text (pack, unpack) import GHC.Exts import GHC.Natural (Natural (..)) import NumHask.Algebra.Additive @@ -65,21 +49,24 @@ import NumHask.Algebra.Module import NumHask.Algebra.Multiplicative import NumHask.Algebra.Ring -import NumHask.Analysis.Metric +import NumHask.Algebra.Metric import NumHask.Data.Complex import NumHask.Data.Integral -import NumHask.Data.LogField -import NumHask.Data.Positive import NumHask.Data.Rational import NumHask.Exception -import Protolude hiding ((*), (**), (+), (-), (.), (/), (<<$>>), (<<*>>), Complex (..), Integral (..), Ratio, Product (..), Rep, Semiring (..), Sum (..), (^), (^^), abs, acos, acosh, asin, asinh, atan, atan2, atanh, ceiling, cis, cos, cosh, even, exp, floor, fromInteger, fromIntegral, fromRational, gcd, imagPart, infinity, log, logBase, magnitude, mkPolar, negate, odd, phase, pi, polar, product, properFraction, realPart, recip, reduce, round, sin, sinh, sqrt, subtract, sum, tan, tanh, toInteger, toRational, trans, truncate, zero) -import System.Random -import System.Random.Stateful +import Prelude hiding ((*), (**), (+), (-), (/), Integral (..), (^), (^^), abs, acos, acosh, asin, asinh, atan, atan2, atanh, ceiling, cos, cosh, even, exp, floor, fromInteger, fromIntegral, fromRational, gcd, log, logBase, negate, odd, pi, product, properFraction, recip, round, sin, sinh, sqrt, subtract, sum, tan, tanh, toInteger, toRational, truncate) +import Data.Bool +import Data.Kind +import GHC.Generics +import Data.Foldable hiding (sum, product) +import Data.Traversable +import Data.Semigroup +import Data.Maybe + -- $usage -- -- >>> :set -XRebindableSyntax --- >>> :set -XNegativeLiterals -- >>> import NumHask.Prelude -- >>> 1+1 -- 2 @@ -92,20 +79,3 @@ ifThenElse :: Bool -> a -> a -> a ifThenElse True x _ = x ifThenElse False _ y = y - --- $extras --- --- Bits and pieces different to protolude, including: --- --- - re-inserting 'id' which should never be overwritten in haskell code. --- --- - 'Data.Bifunctors' & 'Data.Biapplicative' which are favorites of the OA. --- --- - 'Control.Monad.Morph'; another essential, ubiquitous library. --- --- - 'Data.Functor.Constant' --- --- - 'pack' and 'unpack', which may encourage usage of 'String' but can also quickly escape from the same. - --- $protolude --- It would be nice to just link straight through to the [protolude documentation](https://hackage.haskell.org/package/protolude), but, alas, at time of production, haddock insists on dumping everything here. diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -1,9 +1,8 @@ -{-# LANGUAGE RebindableSyntax #-} {-# OPTIONS_GHC -Wall #-} module Main where -import NumHask.Prelude +import Prelude import Test.DocTest main :: IO ()