scientific-0.3.4.4/0000755000000000000000000000000012624733605012176 5ustar0000000000000000scientific-0.3.4.4/LICENSE0000644000000000000000000000276212624733605013212 0ustar0000000000000000Copyright (c) 2013, Bas van Dijk All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Bas van Dijk nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. scientific-0.3.4.4/scientific.cabal0000644000000000000000000001104312624733605015301 0ustar0000000000000000name: scientific version: 0.3.4.4 synopsis: Numbers represented using scientific notation description: @Data.Scientific@ provides the number type 'Scientific'. Scientific numbers are arbitrary precision and space efficient. They are represented using . The implementation uses a coefficient @c :: 'Integer'@ and a base-10 exponent @e :: 'Int'@. A scientific number corresponds to the 'Fractional' number: @'fromInteger' c * 10 '^^' e@. . Note that since we're using an 'Int' to represent the exponent these numbers aren't truly arbitrary precision. I intend to change the type of the exponent to 'Integer' in a future release. . The main application of 'Scientific' is to be used as the target of parsing arbitrary precision numbers coming from an untrusted source. The advantages over using 'Rational' for this are that: . * A 'Scientific' is more efficient to construct. Rational numbers need to be constructed using '%' which has to compute the 'gcd' of the 'numerator' and 'denominator'. . * 'Scientific' is safe against numbers with huge exponents. For example: @1e1000000000 :: 'Rational'@ will fill up all space and crash your program. Scientific works as expected: . > > read "1e1000000000" :: Scientific > 1.0e1000000000 . * Also, the space usage of converting scientific numbers with huge exponents to @'Integral's@ (like: 'Int') or @'RealFloat's@ (like: 'Double' or 'Float') will always be bounded by the target type. homepage: https://github.com/basvandijk/scientific bug-reports: https://github.com/basvandijk/scientific/issues license: BSD3 license-file: LICENSE author: Bas van Dijk maintainer: Bas van Dijk category: Data build-type: Simple cabal-version: >=1.10 extra-source-files: changelog source-repository head type: git location: git://github.com/basvandijk/scientific.git flag bytestring-builder description: Provide the Data.ByteString.Builder.Scientific module (requires bytestring >= 0.10) default: True manual: True flag integer-simple description: Use the integer-simple package instead of integer-gmp default: False library exposed-modules: Data.Scientific Data.Text.Lazy.Builder.Scientific other-modules: Math.NumberTheory.Logarithms GHC.Integer.Logarithms.Compat GHC.Integer.Compat Utils other-extensions: DeriveDataTypeable, BangPatterns ghc-options: -Wall build-depends: base >= 4.3 && < 4.9 , ghc-prim , deepseq >= 1.3 && < 1.5 , text >= 0.8 && < 1.3 , hashable >= 1.1.2 && < 1.3 , vector >= 0.5 && < 0.12 , containers >= 0.1 && < 0.6 , binary >= 0.4.1 && < 0.8 if flag(integer-simple) build-depends: integer-simple CPP-options: -DINTEGER_SIMPLE else build-depends: integer-gmp hs-source-dirs: src default-language: Haskell2010 if flag(bytestring-builder) exposed-modules: Data.ByteString.Builder.Scientific build-depends: bytestring >= 0.10 && < 0.11 test-suite test-scientific type: exitcode-stdio-1.0 hs-source-dirs: test main-is: test.hs default-language: Haskell2010 ghc-options: -Wall build-depends: scientific , base >= 4.3 && < 4.9 , binary >= 0.4.1 && < 0.8 , tasty >= 0.5 && < 0.12 , tasty-ant-xml >= 1.0 && < 1.1 , tasty-hunit >= 0.8 && < 0.10 , tasty-smallcheck >= 0.2 && < 0.9 , tasty-quickcheck >= 0.8 && < 0.9 , smallcheck >= 1.0 && < 1.2 , QuickCheck >= 2.5 && < 2.9 , text >= 0.8 && < 1.3 if flag(bytestring-builder) build-depends: bytestring >= 0.10 && < 0.11 cpp-options: -DBYTESTRING_BUILDER benchmark bench-scientific type: exitcode-stdio-1.0 hs-source-dirs: bench main-is: bench.hs default-language: Haskell2010 ghc-options: -O2 build-depends: scientific , base >= 4.3 && < 4.9 , criterion >= 0.5 && < 1.2 scientific-0.3.4.4/changelog0000644000000000000000000000763212624733605014060 0ustar00000000000000000.3.4.4 * Improved performance of toDecimalDigits by 13%. 0.3.4.3 * Fix build with integer-simple. 0.3.4.2 * Fix build on GHC-7.4. Courtesy of Adam Bergmark.. 0.3.4.1 * Fix build on GHC-7.0.4 0.3.4.0 * Added fromRationalRepetend & toRationalRepetend for safely converting from and to rationals which have a repeating decimal representation like: 1 % 28 = 0.03(571428). * Added a Binary instance. * Various performance improvements. * Support vector-0.11 * Support tasty-0.11 * Support criterion-1.1.0.0 0.3.3.8 * Support QuickCheck-2.8. 0.3.3.7 * Fixed both the Prelude Data.Scientific> reads "0.0" :: [(Data.Scientific.Scientific,String)] [(0.0,".0"),(0.0,"")] problem and the read " 8" :: Scientific fails, while read " 8" :: Double succeeds problem. Courtesy of neongreen. 0.3.3.6 * Fixed bug in the x / y method for Scientific. Since I was using the default implementation: `x * recip y` the operation would diverge when `recip y` had an infinite decimal output. This shouldn't happen when the result of / is finite again. For example: 0.6 / 0.3 should yield 2.0. This is now fixed by using the following implementation: `x / y = fromRational $ toRational x / toRational y` 0.3.3.5 * Fixed bug when converting the Scientific: `scientific 0 someBigExponent` to a bounded Integral using toBoundedInteger or to a bounded RealFloat using toBoundedRealFloat. If someBigExponent was big enough to trigger the big-exponent protection the beforementioned functions didn't return 0. This is fixed by explicitly handling a coefficient of 0. 0.3.3.4 * Relax upper version bounds of base and deepseq for the test suite and benchmarks. 0.3.3.3 * Add support for `deepseq-1.4`. 0.3.3.2 * Fix parsing of empty digit string (#21). 0.3.3.1 * Allow newer tasty, tasty-hunit and criterion. 0.3.3.0 * Add the isFloating or isInteger predicates. Courtesy of Zejun Wu (@watashi). * Add the toRealFloat' and toBoundedInteger functions. Courtesy of Fujimura Daisuke (@fujimura). 0.3.2.2 * Enable package to link with integer-simple instead of integer-gmp using the -finteger-simple cabal flag. Courtesy of @k0ral. 0.3.2.1 * Parameterize inclusion of the Data.ByteString.Builder.Scientific module using the bytestring-builder flag. Disabling this flag allows building on GHC-7.0.4 which has bytestring-0.9 installed by default. 0.3.2.0 * Add the floatingOrInteger function * Fix build on GHC-7.0.4 * More efficient and better behaving magnitude computation * Lower the number of cached magnitudes to 324 (same as GHC.Float) 0.3.1.0 * Don't normalize on construction but do it when pretty-printing instead. Also provide a manual normalize function. * Improve efficiency of toRealFloat * Added note about caching magnitudes * Dropped dependency on arithmoi * Make benchmark easier to build * Add junit XML output support (for Jenkins) 0.3.0.2 * Lower the minimal QuickCheck version. * Make sure sized exponents are generated in the QuickCheck tests. 0.3.0.1 * Fix build for bytestring-0.10.0.* 0.3.0.0 * Fix a DoS vulnerability that allowed an attacker to crash the process by sending a scientific with a huge exponent like 1e1000000000. * Fix various RealFrac methods. * Cache some powers of 10 to speed up the magnitude computation. * Normalize scientific numbers on construction. * Move the Text Builder to its own module & provide a ByteString builder * Added more documentation 0.2.0.2 * Widen the dreaded pointlessly tight upper bounds 0.2.0.1 * Support the latest versions of smallcheck and tasty 0.2.0.0 * added deriving data 0.1.0.1 * Loosen upper bounds on package versions 0.1.0.0 * Fixed bugs & Changed API 0.0.0.2 * Support building the library on GHC >= 7.0.1 0.0.0.1 * Simplification in the Show instance * Optimization in fromRealFloat 0.0.0.0 * Initial commit scientific-0.3.4.4/Setup.hs0000644000000000000000000000005612624733605013633 0ustar0000000000000000import Distribution.Simple main = defaultMain scientific-0.3.4.4/bench/0000755000000000000000000000000012624733605013255 5ustar0000000000000000scientific-0.3.4.4/bench/bench.hs0000644000000000000000000000634012624733605014673 0ustar0000000000000000module Main where import Criterion.Main import Data.Scientific main :: IO () main = defaultMain [ bgroup "realToFrac" [ bgroup "Scientific->Double" [ sToD "pos" pos , sToD "neg" neg , sToD "int" int , sToD "negInt" negInt ] , bgroup "Double->Scientific" [ dToS "pos" pos , dToS "neg" neg , dToS "int" int , dToS "negInt" negInt ] ] , bgroup "floor" [ bench "floor" (nf (floor :: Scientific -> Integer) $! pos) , bench "floorDefault" (nf floorDefault $! pos) ] , bgroup "ceiling" [ bench "ceiling" (nf (ceiling :: Scientific -> Integer) $! pos) , bench "ceilingDefault" (nf ceilingDefault $! pos) ] , bgroup "truncate" [ bench "truncate" (nf (truncate :: Scientific -> Integer) $! pos) , bench "truncateDefault" (nf truncateDefault $! pos) ] , bgroup "round" [ bench "round" (nf (round :: Scientific -> Integer) $! pos) , bench "roundDefault" (nf roundDefault $! pos) ] , bgroup "toDecimalDigits" [ bench "big" (nf toDecimalDigits $! big) ] ] where pos :: Fractional a => a pos = 12345.12345 neg :: Fractional a => a neg = -pos int :: Fractional a => a int = 12345 negInt :: Fractional a => a negInt = -int big :: Scientific big = read $ "0." ++ concat (replicate 20 "0123456789") realToFracStoD :: Scientific -> Double realToFracStoD = fromRational . toRational {-# INLINE realToFracStoD #-} 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 ] dToS :: String -> Double -> Benchmark dToS name f = bgroup name [ bench "fromRealFloat" . nf (realToFrac :: Double -> Scientific) $! f , bench "via Rational" . nf (realToFracDtoS :: Double -> Scientific) $! f ] floorDefault :: Scientific -> Integer floorDefault x = if r < 0 then n - 1 else n where (n,r) = properFraction x {-# INLINE floorDefault #-} ceilingDefault :: Scientific -> Integer ceilingDefault x = if r > 0 then n + 1 else n where (n,r) = properFraction x {-# INLINE ceilingDefault #-} truncateDefault :: Scientific -> Integer truncateDefault x = m where (m,_) = properFraction x {-# INLINE truncateDefault #-} roundDefault :: Scientific -> Integer roundDefault x = let (n,r) = properFraction x m = if r < 0 then n - 1 else n + 1 in case signum (abs r - 0.5) of -1 -> n 0 -> if even n then n else m 1 -> m _ -> error "round default defn: Bad value" {-# INLINE roundDefault #-} scientific-0.3.4.4/src/0000755000000000000000000000000012624733605012765 5ustar0000000000000000scientific-0.3.4.4/src/Utils.hs0000644000000000000000000000154412624733605014425 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} module Utils ( roundTo , i2d ) where import GHC.Base (Int(I#), Char(C#), chr#, ord#, (+#)) roundTo :: Int -> [Int] -> (Int, [Int]) roundTo d is = case f d True is of x@(0,_) -> x (1,xs) -> (1, 1:xs) _ -> error "roundTo: bad Value" where base = 10 b2 = base `quot` 2 f n _ [] = (0, replicate n 0) f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, []) -- Round to even when at exactly half the base | otherwise = (if x >= b2 then 1 else 0, []) f n _ (i:xs) | i' == base = (1,0:ds) | otherwise = (0,i':ds) where (c,ds) = f (n-1) (even i) xs i' = c + i -- | Unsafe conversion for decimal digits. {-# INLINE i2d #-} i2d :: Int -> Char i2d (I# i#) = C# (chr# (ord# '0'# +# i# )) scientific-0.3.4.4/src/Data/0000755000000000000000000000000012624733605013636 5ustar0000000000000000scientific-0.3.4.4/src/Data/Scientific.hs0000644000000000000000000010412612624733605016256 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE PatternGuards #-} -- | -- Module : Data.Scientific -- Copyright : Bas van Dijk 2013 -- License : BSD3 -- Maintainer : Bas van Dijk -- -- This module provides the number type 'Scientific'. Scientific numbers are -- arbitrary precision and space efficient. They are represented using -- . The -- implementation uses an 'Integer' 'coefficient' @c@ and an 'Int' -- 'base10Exponent' @e@. A scientific number corresponds to the 'Fractional' -- number: @'fromInteger' c * 10 '^^' e@. -- -- Note that since we're using an 'Int' to represent the exponent these numbers -- aren't truly arbitrary precision. I intend to change the type of the exponent -- to 'Integer' in a future release. -- -- The main application of 'Scientific' is to be used as the target of parsing -- arbitrary precision numbers coming from an untrusted source. The advantages -- over using 'Rational' for this are that: -- -- * A 'Scientific' is more efficient to construct. Rational numbers need to be -- constructed using '%' which has to compute the 'gcd' of the 'numerator' and -- 'denominator'. -- -- * 'Scientific' is safe against numbers with huge exponents. For example: -- @1e1000000000 :: 'Rational'@ will fill up all space and crash your -- program. Scientific works as expected: -- -- > > read "1e1000000000" :: Scientific -- > 1.0e1000000000 -- -- * Also, the space usage of converting scientific numbers with huge exponents -- to @'Integral's@ (like: 'Int') or @'RealFloat's@ (like: 'Double' or 'Float') -- will always be bounded by the target type. -- -- /WARNING:/ Although @Scientific@ is an instance of 'Fractional', the methods -- are only partially defined! Specifically 'recip' and '/' will diverge -- (i.e. loop and consume all space) when their outputs have an infinite decimal -- expansion. 'fromRational' will diverge when the input 'Rational' has an -- infinite decimal expansion. Consider using 'fromRationalRepetend' for these -- rationals which will detect the repetition and indicate where it starts. -- -- This module is designed to be imported qualified: -- -- @import Data.Scientific as Scientific@ module Data.Scientific ( Scientific -- * Construction , scientific -- * Projections , coefficient , base10Exponent -- * Predicates , isFloating , isInteger -- * Conversions , fromRationalRepetend , toRationalRepetend , floatingOrInteger , toRealFloat , toBoundedRealFloat , toBoundedInteger , fromFloatDigits -- * Pretty printing , formatScientific , FPFormat(..) , toDecimalDigits -- * Normalization , normalize ) where ---------------------------------------------------------------------- -- Imports ---------------------------------------------------------------------- import Control.Exception (throw, ArithException(DivideByZero)) import Control.Monad (mplus) import Control.Monad.ST (runST) import Control.DeepSeq (NFData, rnf) import Data.Binary (Binary, get, put) import Data.Char (intToDigit, ord) import Data.Data (Data) import Data.Function (on) import Data.Hashable (Hashable(..)) 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 Math.NumberTheory.Logarithms (integerLog10') import qualified Numeric (floatToDigits) import qualified Text.Read as Read import Text.Read (readPrec) import qualified Text.ParserCombinators.ReadPrec as ReadPrec import qualified Text.ParserCombinators.ReadP as ReadP import Text.ParserCombinators.ReadP ( ReadP ) import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) #if !MIN_VERSION_base(4,8,0) import Data.Functor ((<$>)) import Control.Applicative ((<*>)) #endif #if MIN_VERSION_base(4,5,0) import Data.Bits (unsafeShiftR) #else import Data.Bits (shiftR) #endif import GHC.Integer (quotRemInteger, quotInteger) import GHC.Integer.Compat (divInteger) import Utils (roundTo) ---------------------------------------------------------------------- -- Type ---------------------------------------------------------------------- -- | An arbitrary-precision number represented using -- . -- -- This type describes the set of all @'Real's@ which have a finite -- decimal expansion. -- -- A scientific number with 'coefficient' @c@ and 'base10Exponent' @e@ -- corresponds to the 'Fractional' number: @'fromInteger' c * 10 '^^' e@ data Scientific = Scientific { coefficient :: !Integer -- ^ The coefficient of a scientific number. -- -- Note that this number is not necessarily normalized, i.e. -- it could contain trailing zeros. -- -- Scientific numbers are automatically normalized when pretty printed or -- in 'toDecimalDigits'. -- -- Use 'normalize' to do manual normalization. , base10Exponent :: {-# UNPACK #-} !Int -- ^ The base-10 exponent of a scientific number. } deriving (Typeable, Data) -- | @scientific c e@ constructs a scientific number which corresponds -- to the 'Fractional' number: @'fromInteger' c * 10 '^^' e@. scientific :: Integer -> Int -> Scientific scientific = Scientific ---------------------------------------------------------------------- -- Instances ---------------------------------------------------------------------- instance NFData Scientific where rnf (Scientific _ _) = () instance Hashable Scientific where hashWithSalt salt = hashWithSalt salt . toRational instance Binary Scientific where put (Scientific c e) = do put c -- In the future I intend to change the type of the base10Exponent e from -- Int to Integer. To support backward compatability I already convert e -- to Integer here: put $ toInteger e get = Scientific <$> get <*> (fromInteger <$> get) instance Eq Scientific where (==) = (==) `on` toRational {-# INLINE (==) #-} (/=) = (/=) `on` toRational {-# INLINE (/=) #-} instance Ord Scientific where (<) = (<) `on` toRational {-# INLINE (<) #-} (<=) = (<=) `on` toRational {-# INLINE (<=) #-} (>) = (>) `on` toRational {-# INLINE (>) #-} (>=) = (>=) `on` toRational {-# INLINE (>=) #-} compare = compare `on` toRational {-# INLINE compare #-} instance Num Scientific where Scientific c1 e1 + Scientific c2 e2 | e1 < e2 = Scientific (c1 + c2*l) e1 | otherwise = Scientific (c1*r + c2 ) e2 where l = magnitude (e2 - e1) r = magnitude (e1 - e2) {-# INLINE (+) #-} Scientific c1 e1 - Scientific c2 e2 | e1 < e2 = Scientific (c1 - c2*l) e1 | otherwise = Scientific (c1*r - c2 ) e2 where l = magnitude (e2 - e1) r = magnitude (e1 - e2) {-# INLINE (-) #-} Scientific c1 e1 * Scientific c2 e2 = Scientific (c1 * c2) (e1 + e2) {-# INLINE (*) #-} abs (Scientific c e) = Scientific (abs c) e {-# INLINE abs #-} negate (Scientific c e) = Scientific (negate c) e {-# INLINE negate #-} signum (Scientific c _) = Scientific (signum c) 0 {-# INLINE signum #-} fromInteger i = Scientific i 0 {-# INLINE fromInteger #-} -- | /WARNING:/ 'toRational' needs to compute the 'Integer' magnitude: -- @10^e@. If applied to a huge exponent this could fill up all space -- and crash your program! -- -- Avoid applying 'toRational' (or 'realToFrac') to scientific numbers -- coming from an untrusted source and use 'toRealFloat' instead. The -- latter guards against excessive space usage. instance Real Scientific where toRational (Scientific c e) | e < 0 = c % magnitude (-e) | otherwise = (c * magnitude e) % 1 {-# INLINE toRational #-} {-# RULES "realToFrac_toRealFloat_Double" realToFrac = toRealFloat :: Scientific -> Double #-} {-# RULES "realToFrac_toRealFloat_Float" realToFrac = toRealFloat :: Scientific -> Float #-} -- | /WARNING:/ 'recip' and '/' will diverge (i.e. loop and consume all space) -- when their outputs are . -- -- 'fromRational' will diverge when the input 'Rational' is a repeating decimal. -- Consider using 'fromRationalRepetend' for these rationals which will detect -- the repetition and indicate where it starts. instance Fractional Scientific where recip = fromRational . recip . toRational {-# INLINE recip #-} x / y = fromRational $ toRational x / toRational y {-# INLINE (/) #-} fromRational rational | d == 0 = throw DivideByZero | otherwise = positivize (longDiv 0 0) (numerator rational) where -- Divide the numerator by the denominator using long division. longDiv :: Integer -> Int -> (Integer -> Scientific) longDiv !c !e 0 = Scientific c e longDiv !c !e !n -- TODO: Use a logarithm here! | n < d = longDiv (c * 10) (e - 1) (n * 10) | otherwise = case n `quotRemInteger` d of (#q, r#) -> longDiv (c + q) e r d = denominator rational -- | Like 'fromRational', this function converts a `Rational` to a `Scientific` -- but instead of diverging (i.e loop and consume all space) on -- -- it detects the repeating part, the /repetend/, and returns where it starts. -- -- To detect the repetition this function consumes space linear in the number of -- digits in the resulting scientific. In order to bound the space usage an -- optional limit can be specified. If the number of digits reaches this limit -- @Left (s, r)@ will be returned. Here @s@ is the 'Scientific' constructed so -- far and @r@ is the remaining 'Rational'. @toRational s + r@ yields the -- original 'Rational' -- -- If the limit is not reached or no limit was specified @Right (s, -- mbRepetendIx)@ will be returned. Here @s@ is the 'Scientific' without any -- repetition and @mbRepetendIx@ specifies if and where in the fractional part -- the repetend begins. -- -- For example: -- -- @fromRationalRepetend Nothing (1 % 28) == Right (3.571428e-2, Just 2)@ -- -- This represents the repeating decimal: @0.03571428571428571428...@ -- which is sometimes also unambiguously denoted as @0.03(571428)@. -- Here the repetend is enclosed in parentheses and starts at the 3rd digit (index 2) -- in the fractional part. Specifying a limit results in the following: -- -- @fromRationalRepetend (Just 4) (1 % 28) == Left (3.5e-2, 1 % 1400)@ -- -- You can expect the following property to hold. -- -- @ forall (mbLimit :: Maybe Int) (r :: Rational). -- r == (case 'fromRationalRepetend' mbLimit r of -- Left (s, r') -> toRational s + r' -- Right (s, mbRepetendIx) -> -- case mbRepetendIx of -- Nothing -> toRational s -- Just repetendIx -> 'toRationalRepetend' s repetendIx) -- @ fromRationalRepetend :: Maybe Int -- ^ Optional limit -> Rational -> Either (Scientific, Rational) (Scientific, Maybe Int) fromRationalRepetend mbLimit rational | d == 0 = throw DivideByZero | num < 0 = case longDiv (-num) of Left (s, r) -> Left (-s, -r) Right (s, mb) -> Right (-s, mb) | otherwise = longDiv num where num = numerator rational longDiv :: Integer -> Either (Scientific, Rational) (Scientific, Maybe Int) longDiv n = case mbLimit of Nothing -> Right $ longDivNoLimit 0 0 M.empty n Just l -> longDivWithLimit (-l) n -- Divide the numerator by the denominator using long division. longDivNoLimit :: Integer -> Int -> M.Map Integer Int -> (Integer -> (Scientific, Maybe Int)) 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) | otherwise = case n `quotRemInteger` d of (#q, r#) -> longDivNoLimit (c + q) e ns r longDivWithLimit :: Int -> Integer -> Either (Scientific, Rational) (Scientific, Maybe Int) longDivWithLimit l = go 0 0 M.empty where go :: Integer -> Int -> M.Map Integer Int -> (Integer -> Either (Scientific, Rational) (Scientific, Maybe Int)) go !c !e _ns 0 = Right (Scientific c e, Nothing) 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) | otherwise = case n `quotRemInteger` d of (#q, r#) -> go (c + q) e ns r d = denominator rational -- | -- Converts a `Scientific` with a /repetend/ (a repeating part in the fraction), -- which starts at the given index, into its corresponding 'Rational'. -- -- For example to convert the repeating decimal @0.03(571428)@ you would use: -- @toRationalRepetend 0.03571428 2 == 1 % 28@ -- -- Preconditions for @toRationalRepetend s r@: -- -- * @r >= 0@ -- -- * @r < -(base10Exponent s)@ -- -- The formula to convert the @Scientific@ @s@ -- with a repetend starting at index @r@ is described in the paper: -- -- and is defined as follows: -- -- @ -- (fromInteger nonRepetend + repetend % nines) / -- fromInteger (10^^r) -- where -- c = coefficient s -- e = base10Exponent s -- -- -- Size of the fractional part. -- f = (-e) -- -- -- Size of the repetend. -- n = f - r -- -- m = 10^^n -- -- (nonRepetend, repetend) = c \`quotRem\` m -- -- nines = m - 1 -- @ -- Also see: 'fromRationalRepetend'. toRationalRepetend :: Scientific -> Int -- ^ Repetend index -> Rational toRationalRepetend s r | r < 0 = error "toRationalRepetend: Negative repetend index!" | r >= f = error "toRationalRepetend: Repetend index >= than number of digits in the fractional part!" | otherwise = (fromInteger nonRepetend + repetend % nines) / fromInteger (magnitude r) where c = coefficient s e = base10Exponent s -- Size of the fractional part. f = (-e) -- Size of the repetend. n = f - r m = magnitude n (#nonRepetend, repetend#) = c `quotRemInteger` m nines = m - 1 instance RealFrac Scientific where -- | The function 'properFraction' takes a Scientific number @s@ -- and returns a pair @(n,f)@ such that @s = n+f@, and: -- -- * @n@ is an integral number with the same sign as @s@; and -- -- * @f@ is a fraction with the same type and sign as @s@, -- and with absolute value less than @1@. properFraction s@(Scientific c e) | e < 0 = if dangerouslySmall c e then (0, s) else case c `quotRemInteger` magnitude (-e) of (#q, r#) -> (fromInteger q, Scientific r e) | otherwise = (toIntegral s, 0) {-# INLINE properFraction #-} -- | @'truncate' s@ returns the integer nearest @s@ -- between zero and @s@ truncate = whenFloating $ \c e -> if dangerouslySmall c e then 0 else fromInteger $ c `quotInteger` magnitude (-e) {-# INLINE truncate #-} -- | @'round' s@ returns the nearest integer to @s@; -- the even integer if @s@ is equidistant between two integers round = whenFloating $ \c e -> if dangerouslySmall c e then 0 else let (#q, r#) = c `quotRemInteger` magnitude (-e) n = fromInteger q m | r < 0 = n - 1 | otherwise = n + 1 f = Scientific r e in case signum $ coefficient $ abs f - 0.5 of -1 -> n 0 -> if even n then n else m 1 -> m _ -> error "round default defn: Bad value" {-# INLINE round #-} -- | @'ceiling' s@ returns the least integer not less than @s@ ceiling = whenFloating $ \c e -> if dangerouslySmall c e then if c <= 0 then 0 else 1 else case c `quotRemInteger` magnitude (-e) of (#q, r#) | r <= 0 -> fromInteger q | otherwise -> fromInteger (q + 1) {-# INLINE ceiling #-} -- | @'floor' s@ returns the greatest integer not greater than @s@ floor = whenFloating $ \c e -> if dangerouslySmall c e then if c < 0 then -1 else 0 else fromInteger (c `divInteger` magnitude (-e)) {-# INLINE floor #-} ---------------------------------------------------------------------- -- Internal utilities ---------------------------------------------------------------------- -- | This function is used in the 'RealFrac' methods to guard against -- computing a huge magnitude (-e) which could take up all space. -- -- Think about parsing a scientific number from an untrusted -- string. An attacker could supply 1e-1000000000. Lets say we want to -- 'floor' that number to an 'Int'. When we naively try to floor it -- using: -- -- @ -- floor = whenFloating $ \c e -> -- fromInteger (c `div` magnitude (-e)) -- @ -- -- We will compute the huge Integer: @magnitude 1000000000@. This -- computation will quickly fill up all space and crash the program. -- -- Note that for large /positive/ exponents there is no risk of a -- space-leak since 'whenFloating' will compute: -- -- @fromInteger c * magnitude e :: a@ -- -- where @a@ is the target type (Int in this example). So here the -- space usage is bounded by the target type. -- -- For large negative exponents we check if the exponent is smaller -- than some limit (currently -324). In that case we know that the -- scientific number is really small (unless the coefficient has many -- digits) so we can immediately return -1 for negative scientific -- numbers or 0 for positive numbers. -- -- More precisely if @dangerouslySmall c e@ returns 'True' the -- scientific number @s@ is guaranteed to be between: -- @-0.1 > s < 0.1@. -- -- Note that we avoid computing the number of decimal digits in c -- (log10 c) if the exponent is not below the limit. dangerouslySmall :: Integer -> Int -> Bool dangerouslySmall c e = e < (-limit) && e < (-integerLog10' (abs c)) - 1 {-# INLINE dangerouslySmall #-} 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 {-# INLINE positivize #-} whenFloating :: (Num a) => (Integer -> Int -> a) -> Scientific -> a whenFloating f s@(Scientific c e) | e < 0 = f c e | otherwise = toIntegral s {-# INLINE whenFloating #-} -- | 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 {-# INLINE toIntegral #-} ---------------------------------------------------------------------- -- Exponentiation with a cache for the most common numbers. ---------------------------------------------------------------------- -- | The same limit as in GHC.Float. maxExpt :: Int maxExpt = 324 expts10 :: V.Vector Integer expts10 = runST $ do mv <- VM.unsafeNew maxExpt VM.unsafeWrite mv 0 1 VM.unsafeWrite mv 1 10 let go !ix | ix == maxExpt = V.unsafeFreeze mv | otherwise = do VM.unsafeWrite mv ix xx VM.unsafeWrite mv (ix+1) (10*xx) go (ix+2) where xx = x * x x = V.unsafeIndex expts10 half #if MIN_VERSION_base(4,5,0) !half = ix `unsafeShiftR` 1 #else !half = ix `shiftR` 1 #endif go 2 -- | @magnitude e == 10 ^ e@ magnitude :: (Num a) => Int -> a magnitude e | e < maxExpt = cachedPow10 e | otherwise = cachedPow10 hi * 10 ^ (e - hi) where cachedPow10 p = fromInteger (V.unsafeIndex expts10 p) hi = maxExpt - 1 {-# INLINE magnitude #-} ---------------------------------------------------------------------- -- Conversions ---------------------------------------------------------------------- -- | Convert a 'RealFloat' (like a 'Double' or 'Float') into a 'Scientific' -- number. -- -- Note that this function uses 'Numeric.floatToDigits' to compute the digits -- and exponent of the 'RealFloat' number. Be aware that the algorithm used in -- 'Numeric.floatToDigits' doesn't work as expected for some numbers, e.g. as -- the 'Double' @1e23@ is converted to @9.9999999999999991611392e22@, and that -- value is shown as @9.999999999999999e22@ rather than the shorter @1e23@; the -- algorithm doesn't take the rounding direction for values exactly half-way -- between two adjacent representable values into account, so if you have a -- value with a short decimal representation exactly half-way between two -- adjacent representable values, like @5^23*2^e@ for @e@ close to 23, the -- algorithm doesn't know in which direction the short decimal representation -- would be rounded and computes more digits fromFloatDigits :: (RealFloat a) => a -> Scientific fromFloatDigits = positivize fromPositiveRealFloat where fromPositiveRealFloat r = go digits 0 0 where (digits, e) = Numeric.floatToDigits 10 r go [] !c !n = Scientific c (e - n) go (d:ds) !c !n = go ds (c * 10 + fromIntegral d) (n + 1) -- | Safely convert a 'Scientific' number into a 'RealFloat' (like a 'Double' or a -- 'Float'). -- -- Note that this function uses 'realToFrac' (@'fromRational' . 'toRational'@) -- internally but it guards against computing huge Integer magnitudes (@10^e@) -- that could fill up all space and crash your program. 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 respectively. Use -- 'toBoundedRealFloat' which explicitly handles this case by returning 'Left'. -- -- Always prefer 'toRealFloat' over 'realToFrac' when converting from scientific -- numbers coming from an untrusted source. toRealFloat :: (RealFloat a) => Scientific -> a toRealFloat = either id id . toBoundedRealFloat -- | 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 where (loLimit, hiLimit) = exponentLimits (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 -- return `Nothing`. -- -- 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 where c = coefficient s integral = e >= 0 || e' >= 0 e = base10Exponent s e' = base10Exponent s' s' = normalize s dangerouslyBig = e > limit && e > integerLog10' (max (abs iMinBound) (abs iMaxBound)) fromIntegerBounded :: Integer -> Maybe i fromIntegerBounded i | i < iMinBound || i > iMaxBound = Nothing | otherwise = Just $ fromInteger i iMinBound = toInteger (minBound :: i) 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: n :: Integer n = toIntegral s' -- | @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'. -- -- 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 ---------------------------------------------------------------------- -- Predicates ---------------------------------------------------------------------- -- | Return 'True' if the scientific is a floating point, 'False' otherwise. -- -- Also see: 'floatingOrInteger'. isFloating :: Scientific -> Bool isFloating = not . isInteger -- | Return 'True' if the scientific is an integer, 'False' otherwise. -- -- Also see: 'floatingOrInteger'. isInteger :: Scientific -> Bool isInteger s = base10Exponent s >= 0 || base10Exponent s' >= 0 where s' = normalize s ---------------------------------------------------------------------- -- Parsing ---------------------------------------------------------------------- instance Read Scientific where readPrec = Read.parens $ ReadPrec.lift (ReadP.skipSpaces >> scientificP) -- A strict pair data SP = SP !Integer {-# UNPACK #-}!Int scientificP :: ReadP Scientific scientificP = do let positive = (('+' ==) <$> ReadP.satisfy isSign) `mplus` return True pos <- positive let step :: Num a => a -> Int -> a step a digit = a * 10 + fromIntegral digit {-# INLINE step #-} n <- foldDigits step 0 let s = SP n 0 fractional = foldDigits (\(SP a e) digit -> SP (step a digit) (e-1)) s SP coeff expnt <- (ReadP.satisfy (== '.') >> fractional) ReadP.<++ return s let signedCoeff | pos = coeff | otherwise = (-coeff) eP = do posE <- positive e <- foldDigits step 0 if posE then return e else return (-e) (ReadP.satisfy isE >> ((Scientific signedCoeff . (expnt +)) <$> eP)) `mplus` return (Scientific signedCoeff expnt) foldDigits :: (a -> Int -> a) -> a -> ReadP a foldDigits f z = do c <- ReadP.satisfy isDecimal let digit = ord c - 48 a = f z digit ReadP.look >>= go a where go !a [] = return a go !a (c:cs) | isDecimal c = do _ <- ReadP.get let digit = ord c - 48 go (f a digit) cs | otherwise = return a isDecimal :: Char -> Bool isDecimal c = c >= '0' && c <= '9' {-# INLINE isDecimal #-} isSign :: Char -> Bool isSign c = c == '-' || c == '+' {-# INLINE isSign #-} isE :: Char -> Bool isE c = c == 'e' || c == 'E' {-# INLINE isE #-} ---------------------------------------------------------------------- -- Pretty Printing ---------------------------------------------------------------------- instance Show Scientific where show s | coefficient s < 0 = '-':showPositive (-s) | otherwise = showPositive s where showPositive :: Scientific -> String showPositive = fmtAsGeneric . toDecimalDigits fmtAsGeneric :: ([Int], Int) -> String fmtAsGeneric x@(_is, e) | e < 0 || e > 7 = fmtAsExponent x | otherwise = fmtAsFixed x fmtAsExponent :: ([Int], Int) -> String fmtAsExponent (is, e) = case ds of "0" -> "0.0e0" [d] -> d : '.' :'0' : 'e' : show_e' (d:ds') -> d : '.' : ds' ++ ('e' : show_e') [] -> error "formatScientific/doFmt/FFExponent: []" where show_e' = show (e-1) ds = map intToDigit is fmtAsFixed :: ([Int], Int) -> String fmtAsFixed (is, e) | e <= 0 = '0':'.':(replicate (-e) '0' ++ ds) | otherwise = let f 0 s rs = mk0 (reverse s) ++ '.':mk0 rs f n s "" = f (n-1) ('0':s) "" f n s (r:rs) = f (n-1) (r:s) rs in f e "" ds where mk0 "" = "0" mk0 ls = ls ds = map intToDigit is -- | Like 'show' but provides rendering options. formatScientific :: FPFormat -> Maybe Int -- ^ Number of decimal places to render. -> Scientific -> String formatScientific format mbDecs s | coefficient s < 0 = '-':formatPositiveScientific (-s) | otherwise = formatPositiveScientific s where formatPositiveScientific :: Scientific -> String formatPositiveScientific s' = case format of Generic -> fmtAsGeneric $ toDecimalDigits s' Exponent -> fmtAsExponentMbDecs $ toDecimalDigits s' Fixed -> fmtAsFixedMbDecs $ toDecimalDigits s' fmtAsGeneric :: ([Int], Int) -> String fmtAsGeneric x@(_is, e) | e < 0 || e > 7 = fmtAsExponentMbDecs x | otherwise = fmtAsFixedMbDecs x fmtAsExponentMbDecs :: ([Int], Int) -> String fmtAsExponentMbDecs x = case mbDecs of Nothing -> fmtAsExponent x Just dec -> fmtAsExponentDecs dec x fmtAsFixedMbDecs :: ([Int], Int) -> String fmtAsFixedMbDecs x = case mbDecs of Nothing -> fmtAsFixed x Just dec -> fmtAsFixedDecs dec x fmtAsExponentDecs :: Int -> ([Int], Int) -> String fmtAsExponentDecs dec (is, e) = let dec' = max dec 1 in case is of [0] -> '0' :'.' : take dec' (repeat '0') ++ "e0" _ -> let (ei,is') = roundTo (dec'+1) is (d:ds') = map intToDigit (if ei > 0 then init is' else is') in d:'.':ds' ++ 'e':show (e-1+ei) fmtAsFixedDecs :: Int -> ([Int], Int) -> String fmtAsFixedDecs dec (is, e) = let dec' = max dec 0 in if e >= 0 then let (ei,is') = roundTo (dec' + e) is (ls,rs) = splitAt (e+ei) (map intToDigit is') in mk0 ls ++ (if null rs then "" else '.':rs) else let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is) d:ds' = map intToDigit (if ei > 0 then is' else 0:is') in d : (if null ds' then "" else '.':ds') where mk0 ls = case ls of { "" -> "0" ; _ -> ls} ---------------------------------------------------------------------- -- | Similar to 'Numeric.floatToDigits', @toDecimalDigits@ takes a -- positive 'Scientific' number, and returns a list of digits and -- a base-10 exponent. In particular, if @x>=0@, and -- -- > toDecimalDigits x = ([d1,d2,...,dn], e) -- -- then -- -- 1. @n >= 1@ -- 2. @x = 0.d1d2...dn * (10^^e)@ -- 3. @0 <= di <= 9@ -- 4. @null $ takeWhile (==0) $ reverse [d1,d2,...,dn]@ -- -- The last property means that the coefficient will be normalized, i.e. doesn't -- contain trailing zeros. toDecimalDigits :: Scientific -> ([Int], Int) toDecimalDigits (Scientific 0 _) = ([0], 1) toDecimalDigits (Scientific c' e') = case normalizePositive c' e' of Scientific c e -> go c 0 [] 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 ---------------------------------------------------------------------- -- Normalization ---------------------------------------------------------------------- -- | Normalize a scientific number by dividing out powers of 10 from the -- 'coefficient' and incrementing the 'base10Exponent' each time. -- -- 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 normalizePositive :: Integer -> Int -> Scientific normalizePositive !c !e = case quotRemInteger c 10 of (# c', r #) | r == 0 -> normalizePositive c' (e+1) | otherwise -> Scientific c e scientific-0.3.4.4/src/Data/ByteString/0000755000000000000000000000000012624733605015730 5ustar0000000000000000scientific-0.3.4.4/src/Data/ByteString/Builder/0000755000000000000000000000000012624733605017316 5ustar0000000000000000scientific-0.3.4.4/src/Data/ByteString/Builder/Scientific.hs0000644000000000000000000000752712624733605021745 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} module Data.ByteString.Builder.Scientific ( scientificBuilder , formatScientificBuilder , FPFormat(..) ) where import Data.Scientific (Scientific) import qualified Data.Scientific as Scientific import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) import qualified Data.ByteString.Char8 as BC8 #if !MIN_VERSION_bytestring(0,10,2) import Data.ByteString.Lazy.Builder (Builder, string8, char8) import Data.ByteString.Lazy.Builder.ASCII (intDec) import Data.ByteString.Lazy.Builder.Extras (byteStringCopy) #else import Data.ByteString.Builder (Builder, string8, char8, intDec) import Data.ByteString.Builder.Extra (byteStringCopy) #endif import Utils (roundTo, i2d) #if !MIN_VERSION_base(4,8,0) import Data.Monoid (mempty) #endif #if MIN_VERSION_base(4,5,0) import Data.Monoid ((<>)) #else import Data.Monoid (Monoid, mappend) (<>) :: Monoid a => a -> a -> a (<>) = mappend infixr 6 <> #endif -- | A @ByteString@ @Builder@ which renders a scientific number to full -- precision, using standard decimal notation for arguments whose -- absolute value lies between @0.1@ and @9,999,999@, and scientific -- notation otherwise. scientificBuilder :: Scientific -> Builder scientificBuilder = formatScientificBuilder Generic Nothing -- | Like 'scientificBuilder' but provides rendering options. formatScientificBuilder :: FPFormat -> Maybe Int -- ^ Number of decimal places to render. -> Scientific -> Builder formatScientificBuilder fmt decs scntfc | scntfc < 0 = char8 '-' <> doFmt fmt (Scientific.toDecimalDigits (-scntfc)) | otherwise = doFmt fmt (Scientific.toDecimalDigits scntfc) where doFmt format (is, e) = let ds = map i2d is in case format of Generic -> doFmt (if e < 0 || e > 7 then Exponent else Fixed) (is,e) Exponent -> case decs of Nothing -> let show_e' = intDec (e-1) in case ds of "0" -> byteStringCopy "0.0e0" [d] -> char8 d <> byteStringCopy ".0e" <> show_e' (d:ds') -> char8 d <> char8 '.' <> string8 ds' <> char8 'e' <> show_e' [] -> error $ "Data.ByteString.Builder.Scientific.formatScientificBuilder" ++ "/doFmt/Exponent: []" Just dec -> let dec' = max dec 1 in case is of [0] -> byteStringCopy "0." <> byteStringCopy (BC8.replicate dec' '0') <> byteStringCopy "e0" _ -> let (ei,is') = roundTo (dec'+1) is (d:ds') = map i2d (if ei > 0 then init is' else is') in char8 d <> char8 '.' <> string8 ds' <> char8 'e' <> intDec (e-1+ei) Fixed -> let mk0 ls = case ls of { "" -> char8 '0' ; _ -> string8 ls} in case decs of Nothing | e <= 0 -> byteStringCopy "0." <> byteStringCopy (BC8.replicate (-e) '0') <> string8 ds | otherwise -> let f 0 s rs = mk0 (reverse s) <> char8 '.' <> mk0 rs f n s "" = f (n-1) ('0':s) "" f n s (r:rs) = f (n-1) (r:s) rs in f e "" ds Just dec -> let dec' = max dec 0 in if e >= 0 then let (ei,is') = roundTo (dec' + e) is (ls,rs) = splitAt (e+ei) (map i2d is') in mk0 ls <> (if null rs then mempty else char8 '.' <> string8 rs) else let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is) d:ds' = map i2d (if ei > 0 then is' else 0:is') in char8 d <> (if null ds' then mempty else char8 '.' <> string8 ds') scientific-0.3.4.4/src/Data/Text/0000755000000000000000000000000012624733605014562 5ustar0000000000000000scientific-0.3.4.4/src/Data/Text/Lazy/0000755000000000000000000000000012624733605015501 5ustar0000000000000000scientific-0.3.4.4/src/Data/Text/Lazy/Builder/0000755000000000000000000000000012624733605017067 5ustar0000000000000000scientific-0.3.4.4/src/Data/Text/Lazy/Builder/Scientific.hs0000644000000000000000000000657712624733605021522 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} module Data.Text.Lazy.Builder.Scientific ( scientificBuilder , formatScientificBuilder , FPFormat(..) ) where import Data.Scientific (Scientific) import qualified Data.Scientific as Scientific import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) import Data.Text.Lazy.Builder (Builder, fromString, singleton, fromText) import Data.Text.Lazy.Builder.Int (decimal) import qualified Data.Text as T (replicate) import Utils (roundTo, i2d) #if MIN_VERSION_base(4,5,0) import Data.Monoid ((<>)) #else import Data.Monoid (Monoid, mappend) (<>) :: Monoid a => a -> a -> a (<>) = mappend infixr 6 <> #endif -- | A @Text@ @Builder@ which renders a scientific number to full -- precision, using standard decimal notation for arguments whose -- absolute value lies between @0.1@ and @9,999,999@, and scientific -- notation otherwise. scientificBuilder :: Scientific -> Builder scientificBuilder = formatScientificBuilder Generic Nothing -- | Like 'scientificBuilder' but provides rendering options. formatScientificBuilder :: FPFormat -> Maybe Int -- ^ Number of decimal places to render. -> Scientific -> Builder formatScientificBuilder fmt decs scntfc | scntfc < 0 = singleton '-' <> doFmt fmt (Scientific.toDecimalDigits (-scntfc)) | otherwise = doFmt fmt (Scientific.toDecimalDigits scntfc) where doFmt format (is, e) = let ds = map i2d is in case format of Generic -> doFmt (if e < 0 || e > 7 then Exponent else Fixed) (is,e) Exponent -> case decs of Nothing -> let show_e' = decimal (e-1) in case ds of "0" -> "0.0e0" [d] -> singleton d <> ".0e" <> show_e' (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e' [] -> error $ "Data.Text.Lazy.Builder.Scientific.formatScientificBuilder" ++ "/doFmt/Exponent: []" Just dec -> let dec' = max dec 1 in case is of [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0" _ -> let (ei,is') = roundTo (dec'+1) is (d:ds') = map i2d (if ei > 0 then init is' else is') in singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei) Fixed -> let mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls} in case decs of Nothing | e <= 0 -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds | otherwise -> let f 0 s rs = mk0 (reverse s) <> singleton '.' <> mk0 rs f n s "" = f (n-1) ('0':s) "" f n s (r:rs) = f (n-1) (r:s) rs in f e "" ds Just dec -> let dec' = max dec 0 in if e >= 0 then let (ei,is') = roundTo (dec' + e) is (ls,rs) = splitAt (e+ei) (map i2d is') in mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs) else let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is) d:ds' = map i2d (if ei > 0 then is' else 0:is') in singleton d <> (if null ds' then "" else singleton '.' <> fromString ds') scientific-0.3.4.4/src/Math/0000755000000000000000000000000012624733605013656 5ustar0000000000000000scientific-0.3.4.4/src/Math/NumberTheory/0000755000000000000000000000000012624733605016301 5ustar0000000000000000scientific-0.3.4.4/src/Math/NumberTheory/Logarithms.hs0000644000000000000000000000507612624733605020756 0ustar0000000000000000{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-} -- | Integer logarithm, copied from Daniel Fischer's @arithmoi@ module Math.NumberTheory.Logarithms ( integerLog10' ) where #if defined(INTEGER_SIMPLE) && __GLASGOW_HASKELL__ < 702 import GHC.Integer.Logarithms (integerLogBase#) import GHC.Base (Int(I#)) -- | Only defined for positive inputs! integerLog10' :: Integer -> Int integerLog10' m = I# (integerLogBase# 10 m) #else import GHC.Base ( Int(I#), Word#, Int# , int2Word#, eqWord#, neWord#, (-#), and#, uncheckedShiftRL# #if __GLASGOW_HASKELL__ >= 707 , isTrue# #endif ) import GHC.Integer.Logarithms.Compat (integerLog2#, wordLog2#) -- | Only defined for positive inputs! integerLog10' :: Integer -> Int integerLog10' n | n < 10 = 0 | n < 100 = 1 | otherwise = ex + integerLog10' (n `quot` integerPower 10 ex) where ln = I# (integerLog2# n) -- u/v is a good approximation of log 2/log 10 u = 1936274 v = 6432163 -- so ex is a good approximation to integerLogBase 10 n ex = fromInteger ((u * fromIntegral ln) `quot` v) -- | Power of an 'Integer' by the left-to-right repeated squaring algorithm. -- This needs two multiplications in each step while the right-to-left -- algorithm needs only one multiplication for 0-bits, but here the -- two factors always have approximately the same size, which on average -- gains a bit when the result is large. -- -- For small results, it is unlikely to be any faster than '(^)', quite -- possibly slower (though the difference shouldn't be large), and for -- exponents with few bits set, the same holds. But for exponents with -- many bits set, the speedup can be significant. -- -- /Warning:/ No check for the negativity of the exponent is performed, -- a negative exponent is interpreted as a large positive exponent. integerPower :: Integer -> Int -> Integer integerPower b (I# e#) = power b (int2Word# e#) power :: Integer -> Word# -> Integer power b w# | isTrue# (w# `eqWord#` 0##) = 1 | isTrue# (w# `eqWord#` 1##) = b | otherwise = go (wordLog2# w# -# 1#) b (b*b) where go 0# l h = if isTrue# ((w# `and#` 1##) `eqWord#` 0##) then l*l else (l*h) go i# l h | w# `hasBit#` i# = go (i# -# 1#) (l*h) (h*h) | otherwise = go (i# -# 1#) (l*l) (l*h) -- | A raw version of testBit for 'Word#'. hasBit# :: Word# -> Int# -> Bool hasBit# w# i# = isTrue# (((w# `uncheckedShiftRL#` i#) `and#` 1##) `neWord#` 0##) #if __GLASGOW_HASKELL__ < 707 isTrue# :: Bool -> Bool isTrue# = id #endif #endif scientific-0.3.4.4/src/GHC/0000755000000000000000000000000012624733605013366 5ustar0000000000000000scientific-0.3.4.4/src/GHC/Integer/0000755000000000000000000000000012624733605014763 5ustar0000000000000000scientific-0.3.4.4/src/GHC/Integer/Compat.hs0000644000000000000000000000062412624733605016544 0ustar0000000000000000{-# LANGUAGE CPP #-} module GHC.Integer.Compat (divInteger) where #ifdef MIN_VERSION_integer_simple #if MIN_VERSION_integer_simple(0,1,1) import GHC.Integer (divInteger) #else divInteger :: Integer -> Integer -> Integer divInteger = div #endif #else #if MIN_VERSION_integer_gmp(0,5,1) import GHC.Integer (divInteger) #else divInteger :: Integer -> Integer -> Integer divInteger = div #endif #endif scientific-0.3.4.4/src/GHC/Integer/Logarithms/0000755000000000000000000000000012624733605017074 5ustar0000000000000000scientific-0.3.4.4/src/GHC/Integer/Logarithms/Compat.hs0000644000000000000000000000717412624733605020664 0ustar0000000000000000{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-} module GHC.Integer.Logarithms.Compat ( integerLog2# , wordLog2# ) where #if __GLASGOW_HASKELL__ >= 702 import GHC.Integer.Logarithms (integerLog2#, wordLog2#) #else #include "MachDeps.h" import GHC.Integer.GMP.Internals (Integer(S#, J#)) import GHC.Base ( indexWordArray#, uncheckedIShiftL#, indexInt8Array# , word2Int#, ByteArray#, newByteArray#, writeInt8Array# , (==#), (<#), (+#), (*#) , unsafeFreezeByteArray#, realWorld# , neWord#, (-#), uncheckedShiftRL# , Int#, Word#, int2Word# ) #if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64) #error Only word sizes 32 and 64 are supported. #endif #if WORD_SIZE_IN_BITS == 32 #define WSHIFT 5 #define MMASK 31 #else #define WSHIFT 6 #define MMASK 63 #endif -- | Calculate the integer base 2 logarithm of an 'Integer'. -- The calculation is much more efficient than for the general case. -- -- The argument must be strictly positive, that condition is /not/ checked. integerLog2# :: Integer -> Int# integerLog2# (S# i) = wordLog2# (int2Word# i) integerLog2# (J# s ba) = check (s -# 1#) where check i = case indexWordArray# ba i of 0## -> check (i -# 1#) w -> wordLog2# w +# (uncheckedIShiftL# i WSHIFT#) -- | This function calculates the integer base 2 logarithm of a 'Word#'. -- @'wordLog2#' 0## = -1#@. {-# INLINE wordLog2# #-} wordLog2# :: Word# -> Int# wordLog2# w = case leadingZeros of BA lz -> let zeros u = indexInt8Array# lz (word2Int# u) in #if WORD_SIZE_IN_BITS == 64 case uncheckedShiftRL# w 56# of a -> if a `neWord#` 0## then 64# -# zeros a else case uncheckedShiftRL# w 48# of b -> if b `neWord#` 0## then 56# -# zeros b else case uncheckedShiftRL# w 40# of c -> if c `neWord#` 0## then 48# -# zeros c else case uncheckedShiftRL# w 32# of d -> if d `neWord#` 0## then 40# -# zeros d else #endif case uncheckedShiftRL# w 24# of e -> if e `neWord#` 0## then 32# -# zeros e else case uncheckedShiftRL# w 16# of f -> if f `neWord#` 0## then 24# -# zeros f else case uncheckedShiftRL# w 8# of g -> if g `neWord#` 0## then 16# -# zeros g else 8# -# zeros w -- Lookup table data BA = BA ByteArray# leadingZeros :: BA leadingZeros = let mkArr s = case newByteArray# 256# s of (# s1, mba #) -> case writeInt8Array# mba 0# 9# s1 of s2 -> let fillA lim val idx st = if idx ==# 256# then st else if idx <# lim then case writeInt8Array# mba idx val st of nx -> fillA lim val (idx +# 1#) nx else fillA (2# *# lim) (val -# 1#) idx st in case fillA 2# 8# 1# s2 of s3 -> case unsafeFreezeByteArray# mba s3 of (# _, ba #) -> ba in case mkArr realWorld# of b -> BA b #endif scientific-0.3.4.4/test/0000755000000000000000000000000012624733605013155 5ustar0000000000000000scientific-0.3.4.4/test/test.hs0000644000000000000000000003501312624733605014472 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Control.Monad import Data.Int import Data.Word import Data.Scientific as Scientific import Test.Tasty import Test.Tasty.Runners.AntXML import Test.Tasty.HUnit (testCase, (@?=), Assertion) import qualified Test.SmallCheck as SC import qualified Test.SmallCheck.Series as SC import qualified Test.Tasty.SmallCheck as SC (testProperty) import qualified Test.QuickCheck as QC import qualified Test.Tasty.QuickCheck as QC (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) import qualified Data.Text.Lazy.Builder.Scientific as T #ifdef BYTESTRING_BUILDER import qualified Data.ByteString.Lazy.Char8 as BLC8 import qualified Data.ByteString.Builder.Scientific as B #if !MIN_VERSION_bytestring(0,10,2) import qualified Data.ByteString.Lazy.Builder as B #else import qualified Data.ByteString.Builder as B #endif #endif main :: IO () main = testMain $ testGroup "scientific" [ smallQuick "normalization" (SC.over normalizedScientificSeries $ \s -> s /= 0 SC.==> abs (Scientific.coefficient s) `mod` 10 /= 0) (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 ] , testGroup "Parsing" [ testCase "reads \"\"" $ testReads "" [] , testCase "reads \"1.\"" $ testReads "1." [(1.0, ".")] , testCase "reads \"1.2e\"" $ testReads "1.2e" [(1.2, "e")] , testCase "reads \"(1.3 )\"" $ testReads "(1.3 )" [(1.3, "")] , testCase "reads \"((1.3))\"" $ testReads "((1.3))" [(1.3, "")] , testCase "reads \" 1.3\"" $ testReads " 1.3" [(1.3, "")] ] , testGroup "Formatting" [ testProperty "read . show == id" $ \s -> read (show s) === s , smallQuick "toDecimalDigits_laws" (SC.over nonNegativeScientificSeries toDecimalDigits_laws) (QC.forAll nonNegativeScientificGen toDecimalDigits_laws) , testGroup "Builder" [ testProperty "Text" $ \s -> formatScientific Scientific.Generic Nothing s == TL.unpack (TLB.toLazyText $ T.formatScientificBuilder Scientific.Generic Nothing s) #ifdef BYTESTRING_BUILDER , testProperty "ByteString" $ \s -> formatScientific Scientific.Generic Nothing s == BLC8.unpack (B.toLazyByteString $ B.formatScientificBuilder Scientific.Generic Nothing s) #endif ] , testProperty "formatScientific_fromFloatDigits" $ \(d::Double) -> formatScientific Scientific.Generic Nothing (Scientific.fromFloatDigits d) == show d -- , testProperty "formatScientific_realToFrac" $ \(d::Double) -> -- formatScientific B.Generic Nothing (realToFrac d :: Scientific) == -- show d ] , testGroup "Num" [ testGroup "Equal to Rational" [ testProperty "fromInteger" $ \i -> fromInteger i === fromRational (fromInteger i) , testProperty "+" $ bin (+) , testProperty "-" $ bin (-) , testProperty "*" $ bin (*) , testProperty "abs" $ unary abs , testProperty "negate" $ unary negate , 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 "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 "subtracting the addition" $ \x y -> x + y - y === x , testProperty "+ and negate" $ \x -> x + negate x === 0 , testProperty "- and negate" $ \x -> 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) ] , testGroup "Real" [ testProperty "fromRational . toRational == id" $ \x -> (fromRational . toRational) x === x ] , testGroup "RealFrac" [ testGroup "Equal to Rational" [ testProperty "properFraction" $ \x -> let (n1::Integer, f1::Scientific) = properFraction x (n2::Integer, f2::Rational) = properFraction (toRational x) in (n1 == n2) && (f1 == fromRational f2) , testProperty "round" $ \(x::Scientific) -> (round x :: Integer) == round (toRational x) , testProperty "truncate" $ \(x::Scientific) -> (truncate x :: Integer) == truncate (toRational x) , testProperty "ceiling" $ \(x::Scientific) -> (ceiling x :: Integer) == ceiling (toRational x) , testProperty "floor" $ \(x::Scientific) -> (floor x :: Integer) == floor (toRational x) ] , testProperty "properFraction_laws" properFraction_laws , testProperty "round" $ \s -> round s == roundDefault s , testProperty "truncate" $ \s -> truncate s == truncateDefault s , testProperty "ceiling" $ \s -> ceiling s == ceilingDefault s , testProperty "floor" $ \s -> floor s == floorDefault s ] , testGroup "Conversions" [ testProperty "fromRationalRepetend" $ \(l, r) -> r == (case fromRationalRepetend (Just l) r of Left (s, rr) -> toRational s + rr Right (s, mbRepetend) -> case mbRepetend of Nothing -> toRational s Just repetend -> toRationalRepetend s repetend) , testGroup "Float" $ conversionsProperties (undefined :: Float) , testGroup "Double" $ conversionsProperties (undefined :: Double) , testGroup "floatingOrInteger" [ testProperty "correct conversion" $ \s -> case floatingOrInteger s :: Either Double Int of Left d -> d == toRealFloat s Right i -> i == fromInteger (coefficient s') * 10^(base10Exponent s') where 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) (\(d::Double) -> genericIsFloating d QC.==> (floatingOrInteger (realToFrac d) :: Either Double Integer) == Left d) ] , testGroup "toBoundedInteger" [ testGroup "correct conversion" [ testProperty "Int64" $ toBoundedIntegerConversion (undefined :: Int64) , testProperty "Word64" $ toBoundedIntegerConversion (undefined :: Word64) , testProperty "NegativeNum" $ toBoundedIntegerConversion (undefined :: NegativeInt) ] ] ] , testGroup "toBoundedRealFloat" [ testCase "0 * 10^1000 == 0" $ toBoundedRealFloat (scientific 0 1000) @?= Right (0 :: Float) ] , testGroup "toBoundedInteger" [ testGroup "to Int64" $ [ testCase "succ of maxBound" $ let i = succ . fromIntegral $ (maxBound :: Int64) s = scientific i 0 in (toBoundedInteger s :: Maybe Int64) @?= Nothing , testCase "pred of minBound" $ let i = pred . fromIntegral $ (minBound :: Int64) s = scientific i 0 in (toBoundedInteger s :: Maybe Int64) @?= Nothing , testCase "0 * 10^1000 == 0" $ toBoundedInteger (scientific 0 1000) @?= Just (0 :: Int64) ] ] , testGroup "Predicates" [ testProperty "isFloating" $ \s -> isFloating s == genericIsFloating s , testProperty "isInteger" $ \s -> isInteger s == not (genericIsFloating s) ] ] testMain :: TestTree -> IO () testMain = defaultMainWithIngredients (antXMLRunner:defaultIngredients) testReads :: String -> [(Scientific, String)] -> Assertion testReads inp out = reads inp @?= out genericIsFloating :: RealFrac a => a -> Bool genericIsFloating a = fromInteger (floor a :: Integer) /= a conversionsProperties :: forall realFloat. ( RealFloat realFloat , QC.Arbitrary realFloat , SC.Serial IO realFloat , Show realFloat ) => realFloat -> [TestTree] conversionsProperties _ = [ -- testProperty "fromFloatDigits_1" $ \(d :: realFloat) -> -- Scientific.fromFloatDigits d === realToFrac d -- testProperty "fromFloatDigits_2" $ \(s :: Scientific) -> -- Scientific.fromFloatDigits (realToFrac s :: realFloat) == s testProperty "toRealFloat" $ \(d :: realFloat) -> (Scientific.toRealFloat . realToFrac) d == d , testProperty "toRealFloat . fromFloatDigits == id" $ \(d :: realFloat) -> (Scientific.toRealFloat . Scientific.fromFloatDigits) d == d -- , testProperty "fromFloatDigits . toRealFloat == id" $ \(s :: Scientific) -> -- Scientific.fromFloatDigits (Scientific.toRealFloat s :: realFloat) == s ] toBoundedIntegerConversion :: forall i. (Integral i, Bounded i, Show i) => i -> Scientific -> Bool toBoundedIntegerConversion _ s = case toBoundedInteger s :: Maybe i of Just i -> i == (fromIntegral $ (coefficient s') * 10^(base10Exponent s')) && i >= minBound && i <= maxBound where s' = normalize s Nothing -> isFloating s || 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 unary :: (forall a. Num a => a -> a) -> Scientific -> Bool unary op a = toRational (op a) == op (toRational a) toDecimalDigits_laws :: Scientific -> Bool toDecimalDigits_laws x = let (ds, e) = Scientific.toDecimalDigits x rule1 = n >= 1 n = length ds rule2 = toRational x == coeff * 10 ^^ e coeff = foldr (\di a -> a / 10 + fromIntegral di) 0 (0:ds) rule3 = all (\di -> 0 <= di && di <= 9) ds rule4 | n == 1 = True | otherwise = null $ takeWhile (==0) $ reverse ds 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) && abs f < 1 where posX = positive x (n, f) = properFraction x :: (Integer, Scientific) positive :: (Ord a, Num a) => a -> Bool positive y = y >= 0 floorDefault :: Scientific -> Integer floorDefault x = if r < 0 then n - 1 else n where (n,r) = properFraction x ceilingDefault :: Scientific -> Integer ceilingDefault x = if r > 0 then n + 1 else n where (n,r) = properFraction x truncateDefault :: Scientific -> Integer truncateDefault x = m where (m,_) = properFraction x roundDefault :: Scientific -> Integer roundDefault x = let (n,r) = properFraction x m = if r < 0 then n - 1 else n + 1 in case signum (abs r - 0.5) of -1 -> n 0 -> if even n then n else m 1 -> m _ -> error "round default defn: Bad value" newtype NegativeInt = NegativeInt Int deriving (Show, Enum, Eq, Ord, Num, Real, Integral) instance Bounded NegativeInt where minBound = -100 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 ---------------------------------------------------------------------- instance QC.Arbitrary Scientific where arbitrary = QC.frequency [ (70, scientific <$> QC.arbitrary <*> intGen) , (20, scientific <$> QC.arbitrary <*> bigIntGen) , (10, scientific <$> pure 0 <*> bigIntGen) ] shrink s = zipWith scientific (QC.shrink $ Scientific.coefficient s) (QC.shrink $ Scientific.base10Exponent s) nonNegativeScientificGen :: QC.Gen Scientific nonNegativeScientificGen = scientific <$> (QC.getNonNegative <$> QC.arbitrary) <*> intGen normalizedScientificGen :: QC.Gen Scientific normalizedScientificGen = Scientific.normalize <$> QC.arbitrary bigIntGen :: QC.Gen Int bigIntGen = QC.sized $ \size -> QC.resize (size * 1000) intGen intGen :: QC.Gen Int #if MIN_VERSION_QuickCheck(2,7,0) intGen = QC.arbitrary #else intGen = QC.sized $ \n -> QC.choose (-n, n) #endif