diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Revision history for scientific-notation +## 0.1.3.0 -- 2021-02-23 + +* Add `greaterThanInt64`. +* Add `fromWord64`. +* Suppress zero exponent when encoding. + ## 0.1.2.0 -- 2020-05-01 * Add `builderUtf8`. diff --git a/scientific-notation.cabal b/scientific-notation.cabal --- a/scientific-notation.cabal +++ b/scientific-notation.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: scientific-notation -version: 0.1.2.0 +version: 0.1.3.0 synopsis: Scientific notation intended for tokenization description: This library provides a type used to represent a number in diff --git a/src/Data/Number/Scientific.hs b/src/Data/Number/Scientific.hs --- a/src/Data/Number/Scientific.hs +++ b/src/Data/Number/Scientific.hs @@ -12,6 +12,7 @@ , small , large , fromFixed + , fromWord64 -- * Consume , toWord , toWord8 @@ -22,6 +23,8 @@ , toInt32 , toInt64 , withExposed + -- * Compare + , greaterThanInt64 -- * Decode , parserSignedUtf8Bytes , parserTrailingUtf8Bytes @@ -87,8 +90,14 @@ (LargeScientific (fromIntegral coeffA) (fromIntegral eB)) | otherwise = eqSmall coeffA eA coeffB eB -data LargeScientific = LargeScientific !Integer !Integer +data LargeScientific = LargeScientific + !Integer -- coefficent + !Integer -- exponent +-- Padding just needs to be any number larger than the number of decimal +-- digits that could represent a 64-bit integer. Normalization of scientific +-- numbers using the small representation is only sound when we know that we +-- are not going to trigger an overflow. padding :: Int padding = 50 @@ -184,6 +193,61 @@ (# (# #) | #) -> Nothing (# | i #) -> Just (I64# i) +-- | Convert a 64-bit unsigned word to a 'Scientific'. +fromWord64 :: Word64 -> Scientific +fromWord64 !w = if w <= 9223372036854775807 + then Scientific (fromIntegral w) 0 zeroLarge + else + let !b = LargeScientific (fromIntegral w) 0 + in Scientific 0 minBound b + +-- | Is the number represented in scientific notation greater than the +-- 64-bit integer argument? +greaterThanInt64 :: Scientific -> Int64 -> Bool +greaterThanInt64 (Scientific coeff0@(I# coeff0# ) e0 large0) tgt@(I64# tgt# ) + | e0 == minBound = largeGreaterThanInt64 large0 tgt + | coeff0 == 0 = 0 > tgt + | e0 == 0 = I64# coeff0# > tgt + | coeff0 > 0 = + if | tgt <= 0 -> True + | e0 > 0 -> case smallToInt coeff0 e0 of + (# (# #) | #) -> True + (# | i# #) -> I64# i# > tgt + -- In last case, e0 is less than zero. + | otherwise -> case posIntExp10 (I# tgt#) (Prelude.negate e0) of + (# (# #) | #) -> False + (# | i# #) -> I64# coeff0# > I64# i# + | otherwise = -- Coefficent is negative + if | tgt >= 0 -> False + | e0 > 0 -> case smallToInt coeff0 e0 of + (# (# #) | #) -> False + (# | i# #) -> I64# i# > tgt + -- In last case, e0 is less than zero. + | otherwise -> case negIntExp10 (I# tgt#) (Prelude.negate e0) of + (# (# #) | #) -> True + (# | i# #) -> I64# coeff0# > I64# i# + +largeGreaterThanInt64 :: LargeScientific -> Int64 -> Bool +largeGreaterThanInt64 large0@(LargeScientific coeff e) !tgt + | coeff == 0 = 0 > tgt + | e == 0 = coeff > fromIntegral @Int64 @Integer tgt + | coeff > 0 = + if | tgt <= 0 -> True + | e > 0 -> case largeToInt large0 of + (# (# #) | #) -> True + (# | i# #) -> I64# i# > tgt + | otherwise -> case posSciLowerBound False coeff e of + Exactly n -> n > fromIntegral @Int64 @Integer tgt + LowerBoundedMagnitude n -> (n+1) > fromIntegral @Int64 @Integer tgt + | otherwise = -- Coefficent is negative + if | tgt >= 0 -> False + | e > 0 -> case largeToInt large0 of + (# (# #) | #) -> False + (# | i# #) -> I64# i# > tgt + | otherwise -> case posSciLowerBound False coeff e of + Exactly n -> n > fromIntegral @Int64 @Integer tgt + LowerBoundedMagnitude n -> n > fromIntegral @Int64 @Integer tgt + -- | Expose the non-normalized exponent and coefficient. withExposed :: (Int -> Int -> a) @@ -793,6 +857,24 @@ 8 -> r * 100000000 _ -> integerTenExp (r * 1000000000) (e - 9) +data Estimate + = Exactly !Integer + | LowerBoundedMagnitude !Integer + -- For positive N, LowerBoundedMagnitude N means that x > N and x < N+1. + -- For negative N, LowerBoundedMagnitude N means that x < N and x > N-1. + +-- Precondition: Exponent is non-positive. Coefficient is non-zero. +-- When calling this from elsewhere, set wasTruncated to False. +posSciLowerBound :: Bool -> Integer -> Integer -> Estimate +posSciLowerBound !wasTruncated !coeff !e + | e == 0 = case wasTruncated of + True -> LowerBoundedMagnitude coeff + False -> Exactly coeff + | otherwise = let (q,r) = quotRem coeff 10 in + case q of + 0 -> LowerBoundedMagnitude 0 + _ -> posSciLowerBound (wasTruncated || r /= 0) q (e + 1) + -- This only works if the number is a power of ten. -- It is only intended to be used by fromFixed. -- Precondition: the Integer is not zero. @@ -859,11 +941,14 @@ builderUtf8 (Scientific coeff e big) | e == 0 = Builder.intDec coeff | e == minBound = let LargeScientific coeff' e' = big in - Builder.integerDec coeff' - <> - Builder.ascii 'e' - <> - Builder.integerDec e' + case e' of + 0 -> Builder.integerDec coeff' + _ -> + Builder.integerDec coeff' + <> + Builder.ascii 'e' + <> + Builder.integerDec e' | otherwise = Builder.fromBounded Nat.constant $ BB.intDec coeff `BB.append` diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -128,6 +128,34 @@ , THU.testCase "U" $ Just (-9.3e17) @=? toInt64 (small (-93) 16) , THU.testCase "V" $ Nothing @=? toInt64 (large 922337203685477581 1) ] + , testGroup "Compare" + [ THU.testCase "A" $ SCI.greaterThanInt64 (small 300 (-2)) 2 @=? True + , THU.testCase "B" $ SCI.greaterThanInt64 (small 300 (-2)) 3 @=? False + , THU.testCase "C" $ SCI.greaterThanInt64 (small 300 (-2)) 4 @=? False + , THU.testCase "D" $ SCI.greaterThanInt64 (small (-300) (-2)) (-2) @=? False + , THU.testCase "E" $ SCI.greaterThanInt64 (small (-300) (-2)) (-3) @=? False + , THU.testCase "F" $ SCI.greaterThanInt64 (small (-300) (-2)) (-4) @=? True + , THU.testCase "G" $ SCI.greaterThanInt64 (small (-300) (-2)) 5 @=? False + , THU.testCase "H" $ SCI.greaterThanInt64 (small 300 (-2)) (-5) @=? True + , THU.testCase "I" $ SCI.greaterThanInt64 (small 300 (-2)) 0 @=? True + , THU.testCase "J" $ SCI.greaterThanInt64 (small 3 0) 0 @=? True + , THU.testCase "K" $ SCI.greaterThanInt64 (small 0 0) 0 @=? False + , THU.testCase "L" $ SCI.greaterThanInt64 (small 0 10) 0 @=? False + , THU.testCase "M" $ SCI.greaterThanInt64 (small 1 100) 20 @=? True + , THU.testCase "N" $ SCI.greaterThanInt64 (small (-5) 100) (-20) @=? False + , THU.testCase "O" $ SCI.greaterThanInt64 (small (-5) (-100)) (-1) @=? True + , THU.testCase "P" $ SCI.greaterThanInt64 (small 42 (-2)) 1 @=? False + , THU.testCase "Q" $ SCI.greaterThanInt64 (small 42 (-1)) 1 @=? True + , THU.testCase "R" $ SCI.greaterThanInt64 (large 5430747472779717375525059 0) 1 @=? True + , THU.testCase "S" $ SCI.greaterThanInt64 (large 5430747472779717375525059 (-100)) 1 @=? False + , THU.testCase "T" $ SCI.greaterThanInt64 (large (-5430747472779717375525059) 0) 1 @=? False + , THU.testCase "U" $ SCI.greaterThanInt64 (large (-5430747472779717375525059) (-100)) (-1) @=? True + , THU.testCase "V" $ SCI.greaterThanInt64 (large (-5430747472779717375525059) (-100)) 0 @=? False + , THU.testCase "W" $ SCI.greaterThanInt64 (large (4e30) (-30)) 4 @=? False + , THU.testCase "X" $ SCI.greaterThanInt64 (large (4e30) (-30)) 3 @=? True + , THU.testCase "Y" $ SCI.greaterThanInt64 (large (-4e30) (-30)) (-4) @=? False + , THU.testCase "Z" $ SCI.greaterThanInt64 (large (-4e30) (-30)) (-5) @=? True + ] , testGroup "Parser" [ testGroup "UTF-8-signed" [ testProperty "small-integer" $ \i ->