summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBasVanDijk <>2017-06-04 14:46:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-06-04 14:46:00 (GMT)
commit6d78f77ce3827625339a905ccb0a0e6feb02cc4c (patch)
tree94a8238ab9eae0a42bc57b1f7d8ccbff72b7c411
parent3f1b2b826828d9af98a14af9a2504abab57662ca (diff)
version 0.3.4.140.3.4.14
-rw-r--r--bench/bench.hs50
-rw-r--r--changelog6
-rw-r--r--scientific.cabal2
-rw-r--r--src/Data/Scientific.hs128
4 files changed, 129 insertions, 57 deletions
diff --git a/bench/bench.hs b/bench/bench.hs
index 2f084fc..4670b56 100644
--- a/bench/bench.hs
+++ b/bench/bench.hs
@@ -1,16 +1,20 @@
module Main where
import Criterion.Main
+import Data.Int
+import Data.Word
import Data.Scientific
main :: IO ()
main = defaultMain
[ bgroup "realToFrac"
[ bgroup "Scientific->Double"
- [ sToD "pos" pos
- , sToD "neg" neg
- , sToD "int" int
- , sToD "negInt" negInt
+ [ sToD "dangerouslyBig" dangerouslyBig
+ , sToD "dangerouslySmall" dangerouslySmall
+ , sToD "pos" pos
+ , sToD "neg" neg
+ , sToD "int" int
+ , sToD "negInt" negInt
]
, bgroup "Double->Scientific"
[ dToS "pos" pos
@@ -40,6 +44,19 @@ main = defaultMain
, bgroup "toDecimalDigits"
[ bench "big" (nf toDecimalDigits $! big)
]
+
+ , bgroup "fromFloatDigits"
+ [ bench "pos" $ nf (fromFloatDigits :: Double -> Scientific) pos
+ , bench "neg" $ nf (fromFloatDigits :: Double -> Scientific) neg
+ , bench "int" $ nf (fromFloatDigits :: Double -> Scientific) int
+ , bench "negInt" $ nf (fromFloatDigits :: Double -> Scientific) negInt
+ ]
+
+ , bgroup "toBoundedInteger"
+ [ bgroup "0" $ benchToBoundedInteger 0
+ , bgroup "dangerouslyBig" $ benchToBoundedInteger dangerouslyBig
+ , bgroup "64" $ benchToBoundedInteger 64
+ ]
]
where
pos :: Fractional a => a
@@ -57,6 +74,12 @@ main = defaultMain
big :: Scientific
big = read $ "0." ++ concat (replicate 20 "0123456789")
+ dangerouslyBig :: Scientific
+ dangerouslyBig = read "1e500"
+
+ dangerouslySmall :: Scientific
+ dangerouslySmall = read "1e-500"
+
realToFracStoD :: Scientific -> Double
realToFracStoD = fromRational . toRational
{-# INLINE realToFracStoD #-}
@@ -65,11 +88,10 @@ realToFracDtoS :: Double -> Scientific
realToFracDtoS = fromRational . toRational
{-# INLINE realToFracDtoS #-}
-
sToD :: String -> Scientific -> Benchmark
sToD name f = bgroup name
- [ bench "fromScientific" . nf (realToFrac :: Scientific -> Double) $! f
- , bench "via Rational" . nf (realToFracStoD :: Scientific -> Double) $! f
+ [ bench "toRealFloat" . nf (realToFrac :: Scientific -> Double) $! f
+ , bench "via Rational" . nf (realToFracStoD :: Scientific -> Double) $! f
]
dToS :: String -> Double -> Benchmark
@@ -101,3 +123,17 @@ roundDefault x = let (n,r) = properFraction x
1 -> m
_ -> error "round default defn: Bad value"
{-# INLINE roundDefault #-}
+
+benchToBoundedInteger :: Scientific -> [Benchmark]
+benchToBoundedInteger s =
+ [ bench "Int" $ nf (toBoundedInteger :: Scientific -> Maybe Int) s
+ , bench "Int8" $ nf (toBoundedInteger :: Scientific -> Maybe Int8) s
+ , bench "Int16" $ nf (toBoundedInteger :: Scientific -> Maybe Int16) s
+ , bench "Int32" $ nf (toBoundedInteger :: Scientific -> Maybe Int32) s
+ , bench "Int64" $ nf (toBoundedInteger :: Scientific -> Maybe Int64) s
+ , bench "Word" $ nf (toBoundedInteger :: Scientific -> Maybe Word) s
+ , bench "Word8" $ nf (toBoundedInteger :: Scientific -> Maybe Word8) s
+ , bench "Word16" $ nf (toBoundedInteger :: Scientific -> Maybe Word16) s
+ , bench "Word32" $ nf (toBoundedInteger :: Scientific -> Maybe Word32) s
+ , bench "Word64" $ nf (toBoundedInteger :: Scientific -> Maybe Word64) s
+ ]
diff --git a/changelog b/changelog
index 5292773..acad17f 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,9 @@
+0.3.4.14
+ * Some minor performance improvements.
+
+0.3.4.13
+ * Support criterion-1.2
+
0.3.4.12
* Support base-4.10
diff --git a/scientific.cabal b/scientific.cabal
index 96e91b7..30e78fc 100644
--- a/scientific.cabal
+++ b/scientific.cabal
@@ -1,5 +1,5 @@
name: scientific
-version: 0.3.4.13
+version: 0.3.4.14
synopsis: Numbers represented using scientific notation
description:
@Data.Scientific@ provides the number type 'Scientific'. Scientific numbers are
diff --git a/src/Data/Scientific.hs b/src/Data/Scientific.hs
index b66e224..0e282e9 100644
--- a/src/Data/Scientific.hs
+++ b/src/Data/Scientific.hs
@@ -98,11 +98,13 @@ import Data.Char (intToDigit, ord)
import Data.Data (Data)
import Data.Function (on)
import Data.Hashable (Hashable(..))
+import Data.Int (Int8, Int16, Int32, Int64)
import qualified Data.Map as M (Map, empty, insert, lookup)
import Data.Ratio ((%), numerator, denominator)
import Data.Typeable (Typeable)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
+import Data.Word (Word8, Word16, Word32, Word64)
import Math.NumberTheory.Logarithms (integerLog10')
import qualified Numeric (floatToDigits)
import qualified Text.Read as Read
@@ -184,26 +186,26 @@ instance Binary Scientific where
instance Eq Scientific where
(==) = (==) `on` toRational
- {-# INLINE (==) #-}
+ {-# INLINABLE (==) #-}
(/=) = (/=) `on` toRational
- {-# INLINE (/=) #-}
+ {-# INLINABLE (/=) #-}
instance Ord Scientific where
(<) = (<) `on` toRational
- {-# INLINE (<) #-}
+ {-# INLINABLE (<) #-}
(<=) = (<=) `on` toRational
- {-# INLINE (<=) #-}
+ {-# INLINABLE (<=) #-}
(>) = (>) `on` toRational
- {-# INLINE (>) #-}
+ {-# INLINABLE (>) #-}
(>=) = (>=) `on` toRational
- {-# INLINE (>=) #-}
+ {-# INLINABLE (>=) #-}
compare = compare `on` toRational
- {-# INLINE compare #-}
+ {-# INLINABLE compare #-}
instance Num Scientific where
Scientific c1 e1 + Scientific c2 e2
@@ -212,7 +214,7 @@ instance Num Scientific where
where
l = magnitude (e2 - e1)
r = magnitude (e1 - e2)
- {-# INLINE (+) #-}
+ {-# INLINABLE (+) #-}
Scientific c1 e1 - Scientific c2 e2
| e1 < e2 = Scientific (c1 - c2*l) e1
@@ -220,23 +222,23 @@ instance Num Scientific where
where
l = magnitude (e2 - e1)
r = magnitude (e1 - e2)
- {-# INLINE (-) #-}
+ {-# INLINABLE (-) #-}
Scientific c1 e1 * Scientific c2 e2 =
Scientific (c1 * c2) (e1 + e2)
- {-# INLINE (*) #-}
+ {-# INLINABLE (*) #-}
abs (Scientific c e) = Scientific (abs c) e
- {-# INLINE abs #-}
+ {-# INLINABLE abs #-}
negate (Scientific c e) = Scientific (negate c) e
- {-# INLINE negate #-}
+ {-# INLINABLE negate #-}
signum (Scientific c _) = Scientific (signum c) 0
- {-# INLINE signum #-}
+ {-# INLINABLE signum #-}
fromInteger i = Scientific i 0
- {-# INLINE fromInteger #-}
+ {-# INLINABLE fromInteger #-}
-- | /WARNING:/ 'toRational' needs to compute the 'Integer' magnitude:
-- @10^e@. If applied to a huge exponent this could fill up all space
@@ -249,7 +251,7 @@ instance Real Scientific where
toRational (Scientific c e)
| e < 0 = c % magnitude (-e)
| otherwise = (c * magnitude e) % 1
- {-# INLINE toRational #-}
+ {-# INLINABLE toRational #-}
{-# RULES
"realToFrac_toRealFloat_Double"
@@ -267,10 +269,10 @@ instance Real Scientific where
-- the repetition and indicate where it starts.
instance Fractional Scientific where
recip = fromRational . recip . toRational
- {-# INLINE recip #-}
+ {-# INLINABLE recip #-}
x / y = fromRational $ toRational x / toRational y
- {-# INLINE (/) #-}
+ {-# INLINABLE (/) #-}
fromRational rational
| d == 0 = throw DivideByZero
@@ -352,7 +354,8 @@ fromRationalRepetend mbLimit rational
longDivNoLimit !c !e _ns 0 = (Scientific c e, Nothing)
longDivNoLimit !c !e ns !n
| Just e' <- M.lookup n ns = (Scientific c e, Just (-e'))
- | n < d = longDivNoLimit (c * 10) (e - 1) (M.insert n e ns) (n * 10)
+ | n < d = let !ns' = M.insert n e ns
+ in longDivNoLimit (c * 10) (e - 1) ns' (n * 10)
| otherwise = case n `quotRemInteger` d of
(#q, r#) -> longDivNoLimit (c + q) e ns r
@@ -367,7 +370,8 @@ fromRationalRepetend mbLimit rational
go !c !e ns !n
| Just e' <- M.lookup n ns = Right (Scientific c e, Just (-e'))
| e <= l = Left (Scientific c e, n % (d * magnitude (-e)))
- | n < d = go (c * 10) (e - 1) (M.insert n e ns) (n * 10)
+ | n < d = let !ns' = M.insert n e ns
+ in go (c * 10) (e - 1) ns' (n * 10)
| otherwise = case n `quotRemInteger` d of
(#q, r#) -> go (c + q) e ns r
@@ -450,7 +454,7 @@ instance RealFrac Scientific where
else case c `quotRemInteger` magnitude (-e) of
(#q, r#) -> (fromInteger q, Scientific r e)
| otherwise = (toIntegral s, 0)
- {-# INLINE properFraction #-}
+ {-# INLINABLE properFraction #-}
-- | @'truncate' s@ returns the integer nearest @s@
-- between zero and @s@
@@ -458,7 +462,7 @@ instance RealFrac Scientific where
if dangerouslySmall c e
then 0
else fromInteger $ c `quotInteger` magnitude (-e)
- {-# INLINE truncate #-}
+ {-# INLINABLE truncate #-}
-- | @'round' s@ returns the nearest integer to @s@;
-- the even integer if @s@ is equidistant between two integers
@@ -475,7 +479,7 @@ instance RealFrac Scientific where
0 -> if even n then n else m
1 -> m
_ -> error "round default defn: Bad value"
- {-# INLINE round #-}
+ {-# INLINABLE round #-}
-- | @'ceiling' s@ returns the least integer not less than @s@
ceiling = whenFloating $ \c e ->
@@ -486,7 +490,7 @@ instance RealFrac Scientific where
else case c `quotRemInteger` magnitude (-e) of
(#q, r#) | r <= 0 -> fromInteger q
| otherwise -> fromInteger (q + 1)
- {-# INLINE ceiling #-}
+ {-# INLINABLE ceiling #-}
-- | @'floor' s@ returns the greatest integer not greater than @s@
floor = whenFloating $ \c e ->
@@ -495,7 +499,7 @@ instance RealFrac Scientific where
then -1
else 0
else fromInteger (c `divInteger` magnitude (-e))
- {-# INLINE floor #-}
+ {-# INLINABLE floor #-}
----------------------------------------------------------------------
@@ -546,8 +550,8 @@ limit :: Int
limit = maxExpt
positivize :: (Ord a, Num a, Num b) => (a -> b) -> (a -> b)
-positivize f x | x < 0 = -(f (-x))
- | otherwise = f x
+positivize f x | x < 0 = -(f (-x))
+ | otherwise = f x
{-# INLINE positivize #-}
whenFloating :: (Num a) => (Integer -> Int -> a) -> Scientific -> a
@@ -559,7 +563,7 @@ whenFloating f s@(Scientific c e)
-- | Precondition: the 'Scientific' @s@ needs to be an integer:
-- @base10Exponent (normalize s) >= 0@
toIntegral :: (Num a) => Scientific -> a
-toIntegral (Scientific c e) = fromInteger c * magnitude e
+toIntegral (Scientific c e) = fromInteger c * fromInteger (magnitude e)
{-# INLINE toIntegral #-}
@@ -593,14 +597,13 @@ expts10 = runST $ do
go 2
-- | @magnitude e == 10 ^ e@
-magnitude :: (Num a) => Int -> a
+magnitude :: Int -> Integer
magnitude e | e < maxExpt = cachedPow10 e
| otherwise = cachedPow10 hi * 10 ^ (e - hi)
where
- cachedPow10 p = fromInteger (V.unsafeIndex expts10 p)
+ cachedPow10 = V.unsafeIndex expts10
hi = maxExpt - 1
-{-# INLINE magnitude #-}
----------------------------------------------------------------------
@@ -629,9 +632,15 @@ fromFloatDigits rf = positivize fromPositiveRealFloat rf
where
(digits, e) = Numeric.floatToDigits 10 r
+ go :: [Int] -> Integer -> Int -> Scientific
go [] !c !n = Scientific c (e - n)
go (d:ds) !c !n = go ds (c * 10 + toInteger d) (n + 1)
+{-# INLINABLE fromFloatDigits #-}
+
+{-# SPECIALIZE fromFloatDigits :: Double -> Scientific #-}
+{-# SPECIALIZE fromFloatDigits :: Float -> Scientific #-}
+
-- | Safely convert a 'Scientific' number into a 'RealFloat' (like a 'Double' or a
-- 'Float').
--
@@ -647,37 +656,47 @@ fromFloatDigits rf = positivize fromPositiveRealFloat rf
toRealFloat :: (RealFloat a) => Scientific -> a
toRealFloat = either id id . toBoundedRealFloat
+{-# INLINABLE toRealFloat #-}
+{-# INLINABLE toBoundedRealFloat #-}
+
+{-# SPECIALIZE toRealFloat :: Scientific -> Double #-}
+{-# SPECIALIZE toRealFloat :: Scientific -> Float #-}
+{-# SPECIALIZE toBoundedRealFloat :: Scientific -> Either Double Double #-}
+{-# SPECIALIZE toBoundedRealFloat :: Scientific -> Either Float Float #-}
+
-- | Preciser version of `toRealFloat`. If the 'base10Exponent' of the given
-- 'Scientific' is too big or too small to be represented in the target type,
-- Infinity or 0 will be returned as 'Left'.
toBoundedRealFloat :: forall a. (RealFloat a) => Scientific -> Either a a
toBoundedRealFloat s@(Scientific c e)
- | c == 0 = Right 0
- | e > limit && e > hiLimit = Left $ sign (1/0) -- Infinity
- | e < -limit && e < loLimit && e + d < loLimit = Left $ sign 0
- | otherwise = Right $ realToFrac s
+ | c == 0 = Right 0
+ | e > limit = if e > hiLimit then Left $ sign (1/0) -- Infinity
+ else Right $ fromRational ((c * magnitude e) % 1)
+ | e < -limit = if e < loLimit && e + d < loLimit then Left $ sign 0
+ else Right $ fromRational (c % magnitude (-e))
+ | otherwise = Right $ fromRational (toRational s)
+ -- We can't use realToFrac here
+ -- because that will cause an infinite loop
+ -- when the function is specialized for Double and Float
+ -- caused by the realToFrac_toRealFloat_Double/Float rewrite RULEs.
where
- (loLimit, hiLimit) = exponentLimits (undefined :: a)
+ hiLimit, loLimit :: Int
+ hiLimit = ceiling (fromIntegral hi * log10Radix)
+ loLimit = floor (fromIntegral lo * log10Radix) -
+ ceiling (fromIntegral digits * log10Radix)
+
+ log10Radix :: Double
+ log10Radix = logBase 10 $ fromInteger radix
+
+ radix = floatRadix (undefined :: a)
+ digits = floatDigits (undefined :: a)
+ (lo, hi) = floatRange (undefined :: a)
d = integerLog10' (abs c)
sign x | c < 0 = -x
| otherwise = x
-exponentLimits :: forall a. (RealFloat a) => a -> (Int, Int)
-exponentLimits _ = (loLimit, hiLimit)
- where
- loLimit = floor (fromIntegral lo * log10Radix) -
- ceiling (fromIntegral digits * log10Radix)
- hiLimit = ceiling (fromIntegral hi * log10Radix)
-
- log10Radix :: Double
- log10Radix = logBase 10 $ fromInteger radix
-
- radix = floatRadix (undefined :: a)
- digits = floatDigits (undefined :: a)
- (lo, hi) = floatRange (undefined :: a)
-
-- | Convert a `Scientific` to a bounded integer.
--
-- If the given `Scientific` doesn't fit in the target representation, it will
@@ -718,6 +737,17 @@ toBoundedInteger s
n :: Integer
n = toIntegral s'
+{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int #-}
+{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int8 #-}
+{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int16 #-}
+{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int32 #-}
+{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int64 #-}
+{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word #-}
+{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word8 #-}
+{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word16 #-}
+{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word32 #-}
+{-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Word64 #-}
+
-- | @floatingOrInteger@ determines if the scientific is floating point
-- or integer. In case it's floating-point the scientific is converted
-- to the desired 'RealFloat' using 'toRealFloat'.