diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,12 @@ +0.3.9.0 + + * Reimplement most internal functions which used to normalize inputs + to not unnecessarily normalize them. + + * Speedup 'normalize' and 'toDecimalDigits'. Now both are practically + linear in the coefficient size. + Thanks to Andrzej Rybczak for reporting these issues. + 0.3.7.0 * Make division (/) on Scientifics slightly more efficient. diff --git a/scientific.cabal b/scientific.cabal --- a/scientific.cabal +++ b/scientific.cabal @@ -1,5 +1,5 @@ name: scientific -version: 0.3.8.1 +version: 0.3.9.0 synopsis: Numbers represented using scientific notation description: "Data.Scientific" provides the number type 'Scientific'. Scientific numbers are @@ -64,9 +64,11 @@ default: False library + -- main module first, so it's loaded into cabal repl. exposed-modules: - Data.ByteString.Builder.Scientific Data.Scientific + exposed-modules: + Data.ByteString.Builder.Scientific Data.Text.Lazy.Builder.Scientific other-modules: @@ -127,11 +129,9 @@ , bytestring , QuickCheck >=2.14.2 , scientific - , smallcheck >=1.0 , tasty >=1.4.0.1 , tasty-hunit >=0.8 , tasty-quickcheck >=0.8 - , tasty-smallcheck >=0.2 , text benchmark bench-scientific diff --git a/src/Data/Scientific.hs b/src/Data/Scientific.hs --- a/src/Data/Scientific.hs +++ b/src/Data/Scientific.hs @@ -6,6 +6,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE ViewPatterns #-} -- | -- Module : Data.Scientific @@ -93,7 +94,6 @@ , normalize ) where - ---------------------------------------------------------------------- -- Imports ---------------------------------------------------------------------- @@ -107,6 +107,7 @@ import Data.Hashable (Hashable(..)) import Data.Int (Int8, Int16, Int32, Int64) import qualified Data.Map as M (Map, empty, insert, lookup) +import Data.Maybe (isJust) import Data.Ratio ((%), numerator, denominator) import Data.Typeable (Typeable) import Data.Word (Word8, Word16, Word32, Word64) @@ -207,38 +208,63 @@ -- is calculated so there's no risk of a blowup in space or time when comparing -- scientific numbers coming from untrusted sources. instance Eq Scientific where - s1 == s2 = c1 == c2 && e1 == e2 - where - Scientific c1 e1 = normalize s1 - Scientific c2 e2 = normalize s2 + Scientific c1 e1 == Scientific c2 e2 + -- if exponents are equal we can compare the coefficients + | e1 == e2 = c1 == c2 + -- if numbers are normalised (i.e. no trailing zeroes in coefficient) + -- we can also compare them directly + | rem c1 10 /= 0 + , rem c2 10 /= 0 + = e1 == e2 && c1 == c2 + + Scientific c1 e1 == Scientific c2 e2 = case compare c1 0 of + EQ -> c2 == 0 + LT -> if c2 < 0 then eqScientific1 (-c1) e1 (-c2) e2 else False + GT -> if c2 > 0 then eqScientific1 c1 e1 c2 e2 else False + +-- | Equality comparison of positive scientific numbers. +-- The coefficients c1 and c2 are positive. +eqScientific1 :: Integer -> Int -> Integer -> Int -> Bool +eqScientific1 c1 e1 c2 e2 + | log1 /= log2 = False -- if logarithms are non-equal, numbers cannot be equal + | otherwise = case compare e1 e2 of + EQ -> c1 == c2 + -- an alternative is to divide by the difference, + -- and check that remainder is zero. + -- + -- I think it doesn't matter in practice. + GT -> c1 * magnitude (e1 - e2) == c2 + LT -> c1 == c2 * magnitude (e2 - e1) + where + log1 = integerLog10' c1 + e1 + log2 = integerLog10' c2 + e2 + -- | Scientific numbers can be safely compared for ordering. No magnitude @10^e@ -- is calculated so there's no risk of a blowup in space or time when comparing -- scientific numbers coming from untrusted sources. instance Ord Scientific where - compare s1 s2 - | c1 == c2 && e1 == e2 = EQ - | c1 < 0 = if c2 < 0 then cmp (-c2) e2 (-c1) e1 else LT - | c1 > 0 = if c2 > 0 then cmp c1 e1 c2 e2 else GT - | otherwise = if c2 > 0 then LT else GT - where - Scientific c1 e1 = normalize s1 - Scientific c2 e2 = normalize s2 - - cmp cx ex cy ey - | log10sx < log10sy = LT - | log10sx > log10sy = GT - | d < 0 = if cx <= (cy `quotInteger` magnitude (-d)) then LT else GT - | d > 0 = if cy > (cx `quotInteger` magnitude d) then LT else GT - | otherwise = if cx < cy then LT else GT - where - log10sx = log10cx + ex - log10sy = log10cy + ey + compare (Scientific c1 e1) (Scientific c2 e2) + | e1 == e2 = compare c1 c2 - log10cx = integerLog10' cx - log10cy = integerLog10' cy + compare (Scientific c1 e1) (Scientific c2 e2) = case compare c1 0 of + EQ -> compare 0 c2 + LT -> if c2 < 0 then cmpScientific (-c2) e2 (-c1) e1 else LT + GT -> if c2 > 0 then cmpScientific c1 e1 c2 e2 else GT - d = log10cx - log10cy +-- | Order comparison of positive scientific numbers. +-- The coeffients c1 and c2 are positive. +cmpScientific :: Integer -> Int -> Integer -> Int -> Ordering +cmpScientific c1 e1 c2 e2 = case compare log1 log2 of + GT -> GT + LT -> LT + EQ -> case compare e1 e2 of + EQ -> compare c1 c2 + GT -> compare (c1 * magnitude (e1 - e2)) c2 + LT -> compare c1 (c2 * magnitude (e2 - e1)) + where + log1 = integerLog10' c1 + e1 + log2 = integerLog10' c2 + e2 -- | /WARNING:/ '+' and '-' compute the 'Integer' magnitude: @10^e@ where @e@ is -- the difference between the @'base10Exponent's@ of the arguments. If these @@ -665,11 +691,6 @@ toIntegral (Scientific c e) = fromInteger c * magnitude e {-# INLINE toIntegral #-} - - - - - ---------------------------------------------------------------------- -- Conversions ---------------------------------------------------------------------- @@ -769,24 +790,16 @@ -- This function also guards against computing huge Integer magnitudes (@10^e@) -- that could fill up all space and crash your program. toBoundedInteger :: forall i. (Integral i, Bounded i) => Scientific -> Maybe i -toBoundedInteger s - | c == 0 = fromIntegerBounded 0 - | integral = if dangerouslyBig - then Nothing - else fromIntegerBounded n - | otherwise = Nothing +toBoundedInteger (isInteger_ -> Just (Scientific c e)) + | c == 0 = fromIntegerBounded 0 + | e == 0 = fromIntegerBounded c + | dangerouslyBig = Nothing + | otherwise = fromIntegerBounded n where - c = coefficient s - - integral = e >= 0 || e' >= 0 - - e = base10Exponent s - e' = base10Exponent s' - - s' = normalize s + l = integerLog10' (abs c) + e - dangerouslyBig = e > limit && - e > integerLog10' (max (abs iMinBound) (abs iMaxBound)) + -- whether logarithm of s is bigger than logarithm of source type bounds + dangerouslyBig = l > 1 + integerLog10' (max (abs iMinBound) (abs iMaxBound)) fromIntegerBounded :: Integer -> Maybe i fromIntegerBounded i @@ -797,10 +810,12 @@ iMaxBound = toInteger (maxBound :: i) -- This should not be evaluated if the given Scientific is dangerouslyBig - -- since it could consume all space and crash the process: + -- since it could consume all space and crash the process n :: Integer - n = toIntegral s' + n = c * magnitude e +toBoundedInteger _ = Nothing + {-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int #-} {-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int8 #-} {-# SPECIALIZE toBoundedInteger :: Scientific -> Maybe Int16 #-} @@ -830,12 +845,11 @@ -- Also see: 'isFloating' or 'isInteger'. floatingOrInteger :: (RealFloat r, Integral i) => Scientific -> Either r i floatingOrInteger s - | base10Exponent s >= 0 = Right (toIntegral s) - | base10Exponent s' >= 0 = Right (toIntegral s') - | otherwise = Left (toRealFloat s') - where - s' = normalize s + | Just s' <- isInteger_ s + = Right (toIntegral s') + | otherwise + = Left (toRealFloat s) ---------------------------------------------------------------------- -- Predicates @@ -851,12 +865,31 @@ -- -- Also see: 'floatingOrInteger'. isInteger :: Scientific -> Bool -isInteger s = base10Exponent s >= 0 || - base10Exponent s' >= 0 - where - s' = normalize s +isInteger = isJust . isInteger_ +-- | Like 'isInteger', but if number is integer, return +-- 'Scientific' such that 'base10exponent' is non-negative. +-- /Note:/ this resulting scientific number might still be not 'normalise'd. +-- +-- @since 0.3.9 +-- +isInteger_ :: Scientific -> Maybe Scientific +isInteger_ s@(Scientific c e) + | e >= 0 = Just s + | c == 0 = Just (Scientific c 0) + | integerLog10' (abs c) < negate e = Nothing + -- here the magnitude (negate e) is smaller than c because of previous check. + -- thus dividing by it once is at least as fast as normalising of whole scientific number + -- in the worst case. + | c < 0 + , let (q, r) = quotRem (negate c) (magnitude (negate e)) + = if r == 0 then Just (Scientific (negate q) 0) else Nothing + + | otherwise + , let (q, r) = quotRem c (magnitude (negate e)) + = if r == 0 then Just (Scientific q 0) else Nothing + ---------------------------------------------------------------------- -- Parsing ---------------------------------------------------------------------- @@ -898,7 +931,8 @@ step a digit = a * 10 + fromIntegral digit {-# INLINE step #-} - n <- foldDigits step 0 + ds <- ReadP.munch1 isDecimal + let n = read ds :: Integer let s = SP n 0 fractional = foldDigits (\(SP a e) digit -> @@ -1079,15 +1113,10 @@ toDecimalDigits (Scientific 0 _) = ([0], 0) toDecimalDigits (Scientific c' e') = case normalizePositive c' e' of - Scientific c e -> go c 0 [] + Scientific c e -> (ds, length ds + e) where - go :: Integer -> Int -> [Int] -> ([Int], Int) - go 0 !n ds = (ds, ne) where !ne = n + e - go i !n ds = case i `quotRemInteger` 10 of - (# q, r #) -> go q (n+1) (d:ds) - where - !d = fromIntegral r - + -- show for Integer is faster than repeated quotRem _ 10 + ds = map (\d -> ord d - ord '0') (show c) ---------------------------------------------------------------------- -- Normalization @@ -1099,13 +1128,23 @@ -- You should rarely have a need for this function since scientific numbers are -- automatically normalized when pretty-printed and in 'toDecimalDigits'. normalize :: Scientific -> Scientific -normalize (Scientific c e) - | c > 0 = normalizePositive c e - | c < 0 = -(normalizePositive (-c) e) - | otherwise {- c == 0 -} = Scientific 0 0 +normalize (Scientific c e) = case compare c 0 of + GT -> normalizePositive c e + LT -> -(normalizePositive (-c) e) + EQ -> Scientific 0 0 normalizePositive :: Integer -> Int -> Scientific -normalizePositive !c !e = case quotRemInteger c 10 of - (# c', r #) - | r == 0 -> normalizePositive c' (e+1) - | otherwise -> Scientific c e +normalizePositive !c !e = case stripPowers c 10 of + (c', k) -> Scientific c' (e+k) + +stripPowers :: Integer -> Integer -> (Integer, Int) +stripPowers !c !p + | r /= 0 + = (c, 0) + + -- remove factors of p*p; this speedups the normalisation by quite a bit. + | let (c', k) = stripPowers q (p*p) + , let (q', r') = quotRem c' p + = if r' == 0 then (q', 2 * k + 2) else (c', 2 * k + 1) + where + (q, r) = quotRem c p diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -4,6 +4,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -14,12 +15,10 @@ import Data.Word import Data.Scientific as Scientific import Test.Tasty -import Test.Tasty.HUnit (testCase, (@?=), Assertion, assertBool) -import qualified Test.SmallCheck as SC -import qualified Test.SmallCheck.Series as SC -import qualified Test.Tasty.SmallCheck as SC (testProperty) +import Test.Tasty.HUnit (testCase, (@?=), (@=?), Assertion, assertBool) +import Test.QuickCheck (Property, (===), (.&&.)) import qualified Test.QuickCheck as QC -import qualified Test.Tasty.QuickCheck as QC (testProperty) +import Test.Tasty.QuickCheck (testProperty) import qualified Data.Binary as Binary (encode, decode) import qualified Data.Text.Lazy as TL (unpack) import qualified Data.Text.Lazy.Builder as TLB (toLazyText) @@ -35,14 +34,58 @@ main = testMain $ testGroup "scientific" [ testGroup "DoS protection" [ testGroup "Eq" - [ testCase "1e1000000" $ assertBool "" $ - (read "1e1000000" :: Scientific) == (read "1e1000000" :: Scientific) + [ testCase "1e1000000" $ assertBool "" $ (read "1e1000000" :: Scientific) == (read "1e1000000" :: Scientific) + , testCase "1e1000000 ineq" $ assertBool "" $ (read "1e1000000" :: Scientific) /= (read "1e1000002" :: Scientific) + + -- this also indirectly checks that 'read' is fast enough. + , testCase "10...0" $ assertBool "" $ + (read "1e1000000" :: Scientific) == + (read ('1' : replicate 1000000 '0')) ] , testGroup "Ord" [ testCase "compare 1234e1000000 123e1000001" $ compare (read "1234e1000000" :: Scientific) (read "123e1000001" :: Scientific) @?= GT + + , testCase "10...0" $ + compare (read "1e1000001" :: Scientific) + (read ('1' : replicate 1000000 '0' ++ "0")) + @?= EQ + , testCase "1...1" $ + compare (read "1e1000001" :: Scientific) + (read ('1' : replicate 1000000 '0' ++ "1")) + @?= LT ] + , testGroup "isInteger" + [ testCase "1e1000000" $ True @=? isInteger (read "1e1000000" :: Scientific) + , testCase "10...0e-1" $ True @=? isInteger (read $ '1' : replicate 1000000 '0' ++ "e-1" :: Scientific) + , testCase "10...0e-10...0" $ True @=? isInteger (read $ '1' : replicate 1000000 '0' ++ "e-1000000" :: Scientific) + , testCase "10...0e-20...0" $ False @=? isInteger (read $ '1' : replicate 1000000 '0' ++ "e-2000000" :: Scientific) + ] + + , testGroup "toBoundedInteger" + [ testCase "1e1000000" $ Nothing @=? toBoundedInteger @Int (read "1e1000000") + , testCase "10...0e-1" $ Nothing @=? toBoundedInteger @Int (read $ '1' : replicate 1000000 '0' ++ "e-1") + ] + + , testGroup "floatingOrInteger" + [ testCase "1e1000000" $ Right (10 ^ (1000000 :: Int) :: Integer) @=? floatingOrInteger @Double @Integer (read "1e1000000") + , testCase "10...0e-1" $ Right (10 ^ ( 999999 :: Int) :: Integer) @=? floatingOrInteger @Double @Integer (read $ '1' : replicate 1000000 '0' ++ "e-1") + ] + + , testGroup "normalize" + [ testCase "1e1000000" $ True @=? isInteger (normalize (read "1e1000000" :: Scientific)) + , testCase "10...0e-1" $ True @=? isInteger (normalize (read $ '1' : replicate 1000000 '0' ++ "e-1" :: Scientific)) + , testCase "10...0e-10...0" $ True @=? isInteger (normalize (read $ '1' : replicate 1000000 '0' ++ "e-1000000" :: Scientific)) + , testCase "10...0e-20...0" $ False @=? isInteger (normalize (read $ '1' : replicate 1000000 '0' ++ "e-2000000" :: Scientific)) + ] + + , testGroup "toDecimalDigits" + [ testCase "9...9" $ do + let (ds, n) = toDecimalDigits (read $ replicate 1000000 '9') + (1000000,1000000) @=? (length ds, n) + ] + , testGroup "RealFrac" [ testGroup "floor" [ testCase "1e1000000" $ (floor (read "1e1000000" :: Scientific) :: Int) @?= 0 @@ -77,20 +120,15 @@ (toRealFloat (read "1e1000000" :: Scientific) :: Double) , testCase "1e-1000000" $ (toRealFloat (read "1e-1000000" :: Scientific) :: Double) @?= 0 ] - , testGroup "toBoundedInteger" - [ testCase "1e1000000" $ (toBoundedInteger (read "1e1000000" :: Scientific) :: Maybe Int) @?= Nothing - ] ] - , smallQuick "normalization" - (SC.over normalizedScientificSeries $ \s -> - s /= 0 SC.==> abs (Scientific.coefficient s) `mod` 10 /= 0) + , testProperty "normalization" (QC.forAll normalizedScientificGen $ \s -> s /= 0 QC.==> abs (Scientific.coefficient s) `mod` 10 /= 0) , testGroup "Binary" [ testProperty "decode . encode == id" $ \s -> - Binary.decode (Binary.encode s) === s + Binary.decode (Binary.encode s) === theSci s ] , testGroup "Parsing" @@ -108,18 +146,16 @@ ] , testGroup "Formatting" - [ testProperty "read . show == id" $ \s -> read (show s) === s + [ testProperty "read . show == id" $ \s -> read (show s) === theSci s , testCase "show (Just 1)" $ testShow (Just 1) "Just 1.0" , testCase "show (Just 0)" $ testShow (Just 0) "Just 0.0" , testCase "show (Just (-1))" $ testShow (Just (-1)) "Just (-1.0)" , testGroup "toDecimalDigits" - [ smallQuick "laws" - (SC.over nonNegativeScientificSeries toDecimalDigits_laws) + [ testProperty "laws" (QC.forAll nonNegativeScientificGen toDecimalDigits_laws) - , smallQuick "== Numeric.floatToDigits" - (toDecimalDigits_eq_floatToDigits . SC.getNonNegative) + , testProperty "== Numeric.floatToDigits" (toDecimalDigits_eq_floatToDigits . QC.getNonNegative) ] @@ -157,7 +193,7 @@ , testGroup "Num" [ testGroup "Equal to Rational" - [ testProperty "fromInteger" $ \i -> fromInteger i === fromRational (fromInteger i) + [ testProperty "fromInteger" $ \i -> fromInteger i === theSci (fromRational (fromInteger i)) , testProperty "+" $ bin (+) , testProperty "-" $ bin (-) , testProperty "*" $ bin (*) @@ -166,27 +202,26 @@ , testProperty "signum" $ unary signum ] - , testProperty "0 identity of +" $ \a -> a + 0 === a - , testProperty "1 identity of *" $ \a -> 1 * a === a - , testProperty "0 identity of *" $ \a -> 0 * a === 0 + , testProperty "0 identity of +" $ \a -> a + 0 === theSci a + , testProperty "1 identity of *" $ \a -> 1 * a === theSci a + , testProperty "0 identity of *" $ \a -> 0 * a === theSci 0 - , testProperty "associativity of +" $ \a b c -> a + (b + c) === (a + b) + c - , testProperty "commutativity of +" $ \a b -> a + b === b + a - , testProperty "distributivity of * over +" $ \a b c -> a * (b + c) === a * b + a * c + , testProperty "associativity of +" $ \a b c -> a + (b + c) === (a + b) + theSci c + , testProperty "commutativity of +" $ \a b -> a + b === b + theSci a + , testProperty "distributivity of * over +" $ \a b c -> a * (b + c) === a * b + a * theSci c - , testProperty "subtracting the addition" $ \x y -> x + y - y === x + , testProperty "subtracting the addition" $ \x y -> x + y - y === theSci x - , testProperty "+ and negate" $ \x -> x + negate x === 0 - , testProperty "- and negate" $ \x -> x - negate x === x + x + , testProperty "+ and negate" $ \x -> theSci x + negate x === 0 + , testProperty "- and negate" $ \x -> theSci x - negate x === x + x - , smallQuick "abs . negate == id" - (SC.over nonNegativeScientificSeries $ \x -> abs (negate x) === x) - (QC.forAll nonNegativeScientificGen $ \x -> abs (negate x) === x) + , testProperty "abs . negate == id" + (QC.forAll nonNegativeScientificGen $ \x -> abs (negate x) === theSci x) ] , testGroup "Real" [ testProperty "fromRational . toRational == id" $ \x -> - (fromRational . toRational) x === x + (fromRational . toRational) x === theSci x ] , testGroup "RealFrac" @@ -194,7 +229,7 @@ [ testProperty "properFraction" $ \x -> let (n1::Integer, f1::Scientific) = properFraction x (n2::Integer, f2::Rational) = properFraction (toRational x) - in (n1 == n2) && (f1 == fromRational f2) + in (n1 === n2) .&&. (f1 === fromRational f2) , testProperty "round" $ \(x::Scientific) -> (round x :: Integer) == round (toRational x) @@ -238,15 +273,15 @@ s' = normalize s , testProperty "Integer == Right" $ \(i::Integer) -> (floatingOrInteger (fromInteger i) :: Either Double Integer) == Right i - , smallQuick "Double == Left" - (\(d::Double) -> genericIsFloating d SC.==> - (floatingOrInteger (realToFrac d) :: Either Double Integer) == Left d) + , testProperty "Double == Left" (\(d::Double) -> genericIsFloating d QC.==> (floatingOrInteger (realToFrac d) :: Either Double Integer) == Left d) ] , testGroup "toBoundedInteger" [ testGroup "correct conversion" - [ testProperty "Int64" $ toBoundedIntegerConversion (undefined :: Int64) + + [ testCase "100e-2" $ toBoundedInteger @Int (read "100e-2") @?= Just 1 + , testProperty "Int64" $ toBoundedIntegerConversion (undefined :: Int64) , testProperty "Word64" $ toBoundedIntegerConversion (undefined :: Word64) , testProperty "NegativeNum" $ toBoundedIntegerConversion (undefined :: NegativeInt) ] @@ -276,6 +311,10 @@ ] ] +-- used as type annotation +theSci :: Scientific -> Scientific +theSci = id + testMain :: TestTree -> IO () testMain = defaultMainWithIngredients defaultIngredients @@ -302,7 +341,6 @@ conversionsProperties :: forall realFloat. ( RealFloat realFloat , QC.Arbitrary realFloat - , SC.Serial IO realFloat , Show realFloat ) => realFloat -> [TestTree] @@ -338,23 +376,6 @@ s < fromIntegral (minBound :: i) || s > fromIntegral (maxBound :: i) -testProperty :: (SC.Testable IO test, QC.Testable test) - => TestName -> test -> TestTree -testProperty n test = smallQuick n test test - -smallQuick :: (SC.Testable IO smallCheck, QC.Testable quickCheck) - => TestName -> smallCheck -> quickCheck -> TestTree -smallQuick n sc qc = testGroup n - [ SC.testProperty "smallcheck" sc - , QC.testProperty "quickcheck" qc - ] - --- | ('==') specialized to 'Scientific' so we don't have to put type --- signatures everywhere. -(===) :: Scientific -> Scientific -> Bool -(===) = (==) -infix 4 === - bin :: (forall a. Num a => a -> a -> a) -> Scientific -> Scientific -> Bool bin op a b = toRational (a `op` b) == toRational a `op` toRational b @@ -378,10 +399,10 @@ in rule1 && rule2 && rule3 && rule4 -properFraction_laws :: Scientific -> Bool -properFraction_laws x = fromInteger n + f === x && - (positive n == posX || n == 0) && - (positive f == posX || f == 0) && +properFraction_laws :: Scientific -> Property +properFraction_laws x = fromInteger n + f === x .&&. + (positive n == posX || n == 0) .&&. + (positive f == posX || f == 0) .&&. abs f < 1 where posX = positive x @@ -419,23 +440,6 @@ maxBound = -10 ---------------------------------------------------------------------- --- SmallCheck instances ----------------------------------------------------------------------- - -instance (Monad m) => SC.Serial m Scientific where - series = scientifics - -scientifics :: (Monad m) => SC.Series m Scientific -scientifics = SC.cons2 scientific - -nonNegativeScientificSeries :: (Monad m) => SC.Series m Scientific -nonNegativeScientificSeries = liftM SC.getNonNegative SC.series - -normalizedScientificSeries :: (Monad m) => SC.Series m Scientific -normalizedScientificSeries = liftM Scientific.normalize SC.series - - ----------------------------------------------------------------------- -- QuickCheck instances ---------------------------------------------------------------------- @@ -447,10 +451,13 @@ <*> bigIntGen) , (10, scientific <$> pure 0 <*> bigIntGen) + , (10, (\c e' e -> scientific (c * 10 ^ min 10 (abs e')) e) <$> QC.arbitrary <*> intGen <*> intGen) ] - shrink s = zipWith scientific (QC.shrink $ Scientific.coefficient s) - (QC.shrink $ Scientific.base10Exponent s) + shrink s = + [ scientific c e + | (c, e) <- QC.shrink (Scientific.coefficient s, Scientific.base10Exponent s) + ] nonNegativeScientificGen :: QC.Gen Scientific nonNegativeScientificGen =