extended-reals 0.2.6.0 → 0.2.7.0
raw patch · 4 files changed
+171/−19 lines, 4 filesdep ~QuickCheckdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: QuickCheck, base
API changes (from Hackage documentation)
+ Data.ExtendedReal: toRealFloat :: RealFloat r => Extended r -> r
Files
- CHANGELOG.markdown +5/−0
- extended-reals.cabal +5/−8
- src/Data/ExtendedReal.hs +53/−5
- test/TestExtendedReal.hs +108/−6
CHANGELOG.markdown view
@@ -1,3 +1,8 @@+# 0.2.7.0++* add `toRealFloat` helper+* fix multiplication of infinities for `Extended (Down t)`+ # 0.2.6.0 * add `instance {Foldable,Traversable,Generic,Lift}`
extended-reals.cabal view
@@ -1,5 +1,5 @@ name: extended-reals-version: 0.2.6.0+version: 0.2.7.0 synopsis: Extension of real numbers with positive/negative infinities description: Extension of real numbers with positive/negative infinities (±∞).@@ -15,19 +15,16 @@ cabal-version: >=1.10 bug-reports: https://github.com/msakai/extended-reals/issues tested-with:- GHC ==8.0.2- GHC ==8.2.2- GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.4 GHC ==8.10.7 GHC ==9.0.2 GHC ==9.2.8 GHC ==9.4.8- GHC ==9.6.6+ GHC ==9.6.7 GHC ==9.8.4- GHC ==9.10.1- GHC ==9.12.1+ GHC ==9.10.2+ GHC ==9.12.2 source-repository head type: git@@ -37,7 +34,7 @@ exposed-modules: Data.ExtendedReal other-extensions: DeriveDataTypeable build-depends:- base >=4.9 && <5,+ base >=4.12 && <5, deepseq >=1.3 && <1.6, hashable >=1.2 && <1.6, template-haskell <3
src/Data/ExtendedReal.hs view
@@ -3,6 +3,8 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.ExtendedReal@@ -32,6 +34,7 @@ , isFinite , isInfinite , fromRealFloat+ , toRealFloat ) where import Prelude hiding (isInfinite)@@ -40,6 +43,7 @@ import Data.Data (Data) import Data.Hashable import GHC.Generics (Generic)+import qualified GHC.Real import Language.Haskell.TH.Syntax (Lift) -- | @Extended r@ is an extension of /r/ with positive/negative infinity (±∞).@@ -96,10 +100,10 @@ Finite x1 * e = scale x1 e e * Finite x2 = scale x2 e- PosInf * PosInf = PosInf- PosInf * NegInf = NegInf- NegInf * PosInf = NegInf- NegInf * NegInf = PosInf+ PosInf * PosInf = numericPosInf+ PosInf * NegInf = numericNegInf+ NegInf * PosInf = numericNegInf+ NegInf * NegInf = numericPosInf negate NegInf = PosInf negate (Finite x) = Finite (negate x)@@ -115,12 +119,22 @@ fromInteger = Finite . fromInteger +numericPosInf :: forall r. (Ord r, Num r) => Extended r+numericPosInf = if (1 :: r) >= 0 then PosInf else NegInf++numericNegInf :: forall r. (Ord r, Num r) => Extended r+numericNegInf = if (1 :: r) >= 0 then NegInf else PosInf+ -- | Note that @Extended r@ is /not/ a field, nor a ring. instance (Fractional r, Ord r) => Fractional (Extended r) where recip (Finite x) = Finite (1/x) recip _ = Finite 0 - fromRational = Finite . fromRational+ fromRational r+ | r == GHC.Real.notANumber = error "fromRational: argument should not be NaN"+ | r == GHC.Real.infinity = PosInf+ | r == -GHC.Real.infinity = NegInf+ | otherwise = Finite $ fromRational r -- Note that we define @0 * PosInf = 0 * NegInf = 0@ by the convention of probability or measure theory. scale :: (Num r, Ord r) => r -> Extended r -> Extended r@@ -148,9 +162,43 @@ -- >>> fromRealFloat (0 / 0) -- *** Exception: fromRealFloat: argument should not be NaN --+-- Beware that an ordinal infinity might not be equal to an arithmetic infinity.+-- 'PosInf' / 'NegInf' stand for infinite elements with regards to ordering, so:+--+-- >>> fromRealFloat (Down (1 / 0))+-- NegInf+-- >>> fromRealFloat (Down (-1 / 0))+-- PosInf+-- -- @since 0.2.5.0 fromRealFloat :: RealFloat r => r -> Extended r fromRealFloat x | isNaN x = error "fromRealFloat: argument should not be NaN" | P.isInfinite x = if x > 0 then PosInf else NegInf | otherwise = Finite x++-- | Helper to convert 'Extended' to 'Double' or 'Float',+-- taking care of infinite values automatically.+--+-- >>> toRealFloat PosInf :: Double+-- Infinity+-- >>> toRealFloat NegInf :: Double+-- -Infinity+-- >>> toRealFloat PosInf :: Down Double+-- Down (-Infinity)+-- >>> toRealFloat NegInf :: Down Double+-- Down Infinity+--+-- @since 0.2.7.0+toRealFloat :: RealFloat r => Extended r -> r+toRealFloat = \case+ NegInf -> negInf+ Finite r -> r+ PosInf -> posInf+ where+ -- Less hacky than 1/0, but hacky nevertheless.+ infinity = encodeFloat 1 maxBound+ -- For Data.Ord.Down Double an arithmetic positive infinity+ -- is a negative infinity with regards to Ord instance.+ posInf = if infinity > 0 then infinity else -infinity+ negInf = negate posInf
test/TestExtendedReal.hs view
@@ -1,11 +1,17 @@-{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} {-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Avoid restricted function" #-}+{-# HLINT ignore "Functor law" #-}+{-# HLINT ignore "Redundant negate" #-}+ import Prelude hiding (isInfinite) import Control.DeepSeq import Control.Exception (SomeException, evaluate, try)-import Control.Monad import Data.Maybe+import Data.Ord (Down(..))+import qualified GHC.Real import System.IO.Unsafe (unsafePerformIO) import Test.QuickCheck.Function@@ -18,11 +24,11 @@ -- ---------------------------------------------------------------------- instance Arbitrary r => Arbitrary (Extended r) where- arbitrary = + arbitrary = oneof [ return NegInf , return PosInf- , liftM Finite arbitrary+ , fmap Finite arbitrary ] eval :: a -> Maybe a@@ -95,7 +101,7 @@ ==> eval (a * (b + c)) == eval (a * b + a * c) prop_mult_zero :: Property-prop_mult_zero = +prop_mult_zero = forAll arbitrary $ \(a :: Extended Rational) -> 0 * a == 0 @@ -107,6 +113,23 @@ a <= b && c > 0 && isDefined (a*c) && isDefined (b*c) ==> a*c <= b*c +prop_mult_down_1 :: Property+prop_mult_down_1 = once $+ fromRealFloat (sqr infinity) === sqr (fromRealFloat infinity)+ where+ infinity :: Down Double+ infinity = Down (1 / 0)++ sqr :: Num a => a -> a+ sqr x = x * x++prop_mult_down_2 :: Property+prop_mult_down_2 = once $+ fromRealFloat (infinity * (-infinity)) === fromRealFloat infinity * fromRealFloat (-infinity)+ where+ infinity :: Down Double+ infinity = Down (1 / 0)+ -- We define 0 * PosInf = 0 case_mult_zero_PosInf :: IO () case_mult_zero_PosInf =@@ -118,7 +141,7 @@ 0 * (- inf) @?= (0 :: Extended Rational) prop_negate_inverse :: Property-prop_negate_inverse = +prop_negate_inverse = forAll arbitrary $ \(a :: Extended Rational) -> negate (negate a) == a @@ -152,6 +175,23 @@ prop_isFinite_fromRational = forAll arbitrary $ \a -> isFinite (fromRational a :: Extended Rational) +prop_fromRational_PosInf :: Property+prop_fromRational_PosInf = once $+ fromRational GHC.Real.infinity === (PosInf :: Extended Rational)++prop_fromRational_NegInf :: Property+prop_fromRational_NegInf = once $+ fromRational (-GHC.Real.infinity) === (NegInf :: Extended Rational)++prop_fromRational_NaN :: Property+prop_fromRational_NaN = once $ ioProperty $ do+ let nan :: Extended Double+ nan = fromRational GHC.Real.notANumber+ nan' <- try $ evaluate nan+ pure $ case nan' of+ Left (_ :: SomeException) -> True+ Right _ -> False+ prop_isInfinite_PosInf :: Property prop_isInfinite_PosInf = property $ isInfinite PosInf @@ -188,6 +228,68 @@ prop_deepseq = forAll arbitrary $ \(a :: Extended Rational) -> a `deepseq` () == ()++-- ----------------------------------------------------------------------+-- fromRealFloat++prop_fromRealFloat_PosInf :: Property+prop_fromRealFloat_PosInf = once $+ fromRealFloat (1 / 0 :: Double) === PosInf++prop_fromRealFloat_NegInf :: Property+prop_fromRealFloat_NegInf = once $+ fromRealFloat (-(1 / 0) :: Double) === NegInf++prop_fromRealFloat_NaN :: Property+prop_fromRealFloat_NaN = once $ ioProperty $ do+ let nan = fromRealFloat (0 / 0 :: Double)+ nan' <- try $ evaluate nan+ pure $ case nan' of+ Left (_ :: SomeException) -> True+ Right _ -> False++prop_fromRealFloat_Down_NegInf :: Property+prop_fromRealFloat_Down_NegInf = once $+ fromRealFloat (1 / 0 :: Down Double) === NegInf++prop_fromRealFloat_Down_PosInf :: Property+prop_fromRealFloat_Down_PosInf = once $+ fromRealFloat (-(1 / 0) :: Down Double) === PosInf++prop_fromRealFloat_Down_NaN :: Property+prop_fromRealFloat_Down_NaN = once $ ioProperty $ do+ let nan = fromRealFloat (0 / 0 :: Down Double)+ nan' <- try $ evaluate nan+ pure $ case nan' of+ Left (_ :: SomeException) -> True+ Right _ -> False++-- ----------------------------------------------------------------------+-- toRealFloat++prop_toRealFloat_PosInf :: Property+prop_toRealFloat_PosInf = once $+ (1 / 0 :: Double) === toRealFloat PosInf++prop_toRealFloat_NegInf :: Property+prop_toRealFloat_NegInf = once $+ (-(1 / 0) :: Double) === toRealFloat NegInf++prop_toRealFloat_Down_NegInf :: Property+prop_toRealFloat_Down_NegInf = once $+ (1 / 0 :: Down Double) === toRealFloat NegInf++prop_toRealFloat_Down_PosInf :: Property+prop_toRealFloat_Down_PosInf = once $+ (-(1 / 0) :: Down Double) === toRealFloat PosInf++prop_toRealFloat_fromRealFloat :: Double -> Property+prop_toRealFloat_fromRealFloat x =+ toRealFloat (fromRealFloat x) === x++prop_fromRealFloat_toRealFloat :: Extended Double -> Property+prop_fromRealFloat_toRealFloat x =+ fromRealFloat (toRealFloat x) === x -- ---------------------------------------------------------------------- -- Test harness