Hello community, here is the log from the commit of package ghc-scientific for openSUSE:Factory checked in at 2015-10-08 08:24:39 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-scientific (Old) and /work/SRC/openSUSE:Factory/.ghc-scientific.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-scientific" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-scientific/ghc-scientific.changes 2015-04-30 11:51:27.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-scientific.new/ghc-scientific.changes 2015-10-08 08:24:40.000000000 +0200 @@ -1,0 +2,14 @@ +Sun Oct 4 16:52:33 UTC 2015 - [email protected] + +- update to 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 + +------------------------------------------------------------------- Old: ---- scientific-0.3.3.8.tar.gz New: ---- scientific-0.3.4.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-scientific.spec ++++++ --- /var/tmp/diff_new_pack.OEvTKH/_old 2015-10-08 08:24:41.000000000 +0200 +++ /var/tmp/diff_new_pack.OEvTKH/_new 2015-10-08 08:24:41.000000000 +0200 @@ -1,5 +1,5 @@ # -# spec file for package ghc +# spec file for package ghc-scientific # # Copyright (c) 2015 SUSE LINUX GmbH, Nuernberg, Germany. # @@ -18,8 +18,8 @@ %global pkg_name scientific -Name: ghc-%{pkg_name} -Version: 0.3.3.8 +Name: ghc-scientific +Version: 0.3.4.0 Release: 0 Summary: Numbers represented using scientific notation License: BSD-3-Clause @@ -36,6 +36,7 @@ BuildRequires: ghc-hashable-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel +BuildRequires: ghc-vector-devel %description Data.Scientific provides a space efficient and arbitrary precision scientific ++++++ scientific-0.3.3.8.tar.gz -> scientific-0.3.4.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/scientific-0.3.3.8/changelog new/scientific-0.3.4.0/changelog --- old/scientific-0.3.3.8/changelog 2015-03-19 09:26:29.000000000 +0100 +++ new/scientific-0.3.4.0/changelog 2015-09-30 09:16:10.000000000 +0200 @@ -1,3 +1,14 @@ +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. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/scientific-0.3.3.8/scientific.cabal new/scientific-0.3.4.0/scientific.cabal --- old/scientific-0.3.3.8/scientific.cabal 2015-03-19 09:26:29.000000000 +0100 +++ new/scientific-0.3.4.0/scientific.cabal 2015-09-30 09:16:10.000000000 +0200 @@ -1,17 +1,18 @@ name: scientific -version: 0.3.3.8 +version: 0.3.4.0 synopsis: Numbers represented using scientific notation description: - @Data.Scientific@ provides a space efficient and arbitrary precision - scientific number type. - . - 'Scientific' numbers are represented using - <http://en.wikipedia.org/wiki/Scientific_notation scientific notation>. It - uses a coefficient @c :: 'Integer'@ and a base-10 exponent @e :: 'Int'@ (do - note that since we're using an 'Int' to represent the exponent these numbers - aren't truly arbitrary precision). A scientific number corresponds to the + @Data.Scientific@ provides the number type 'Scientific'. Scientific numbers are + arbitrary precision and space efficient. They are represented using + <http://en.wikipedia.org/wiki/Scientific_notation scientific notation>. + 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: @@ -62,6 +63,7 @@ exposed-modules: Data.Scientific Data.Text.Lazy.Builder.Scientific other-modules: Math.NumberTheory.Logarithms + Utils other-extensions: DeriveDataTypeable, BangPatterns ghc-options: -Wall build-depends: base >= 4.3 && < 4.9 @@ -69,7 +71,9 @@ , deepseq >= 1.3 && < 1.5 , text >= 0.8 && < 1.3 , hashable >= 1.1.2 && < 1.3 - , array >= 0.1 && < 0.6 + , vector >= 0.5 && < 0.12 + , containers >= 0.5 && < 0.6 + , binary >= 0.4.1 && < 0.8 if flag(integer-simple) build-depends: integer-simple @@ -82,7 +86,10 @@ if flag(bytestring-builder) exposed-modules: Data.ByteString.Builder.Scientific - build-depends: bytestring >= 0.10 && < 0.11 + build-depends: bytestring >= 0.10 && < 0.11 + + if impl(ghc >= 7.2.1) + cpp-options: -DGENERICS test-suite test-scientific type: exitcode-stdio-1.0 @@ -93,7 +100,8 @@ build-depends: scientific , base >= 4.3 && < 4.9 - , tasty >= 0.5 && < 0.11 + , 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 @@ -101,7 +109,10 @@ , smallcheck >= 1.0 && < 1.2 , QuickCheck >= 2.5 && < 2.9 , text >= 0.8 && < 1.3 - , bytestring >= 0.10 && < 0.11 + + if flag(bytestring-builder) + build-depends: bytestring >= 0.10 && < 0.11 + cpp-options: -DBYTESTRING_BUILDER benchmark bench-scientific type: exitcode-stdio-1.0 @@ -110,13 +121,13 @@ default-language: Haskell2010 ghc-options: -O2 build-depends: base >= 4.3 && < 4.9 - , criterion >= 0.5 && < 1.1 + , criterion >= 0.5 && < 1.2 , ghc-prim , deepseq >= 1.3 && < 1.5 , text >= 0.8 && < 1.3 , bytestring >= 0.10 && < 0.11 , hashable >= 1.1.2 && < 1.3 - , array >= 0.1 && < 0.6 + , vector >= 0.5 && < 0.12 if flag(integer-simple) build-depends: integer-simple diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/scientific-0.3.3.8/src/Data/ByteString/Builder/Scientific.hs new/scientific-0.3.4.0/src/Data/ByteString/Builder/Scientific.hs --- old/scientific-0.3.3.8/src/Data/ByteString/Builder/Scientific.hs 2015-03-19 09:26:29.000000000 +0100 +++ new/scientific-0.3.4.0/src/Data/ByteString/Builder/Scientific.hs 2015-09-30 09:16:10.000000000 +0200 @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, MagicHash, OverloadedStrings #-} +{-# LANGUAGE CPP, OverloadedStrings #-} module Data.ByteString.Builder.Scientific ( scientificBuilder @@ -22,8 +22,10 @@ import Data.ByteString.Builder.Extra (byteStringCopy) #endif -import GHC.Base (Int(I#), Char(C#), chr#, ord#, (+#)) +#if !MIN_VERSION_base(4,8,0) import Data.Monoid (mempty) +#endif + #if MIN_VERSION_base(4,5,0) import Data.Monoid ((<>)) #else @@ -33,6 +35,8 @@ infixr 6 <> #endif +import Utils (roundTo, i2d) + -- | 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 @@ -107,29 +111,3 @@ d:ds' = map i2d (if ei > 0 then is' else 0:is') in char8 d <> (if null ds' then mempty else char8 '.' <> string8 ds') - --- | Unsafe conversion for decimal digits. -{-# INLINE i2d #-} -i2d :: Int -> Char -i2d (I# i#) = C# (chr# (ord# '0'# +# i#)) - -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/scientific-0.3.3.8/src/Data/Scientific.hs new/scientific-0.3.4.0/src/Data/Scientific.hs --- old/scientific-0.3.3.8/src/Data/Scientific.hs 2015-03-19 09:26:29.000000000 +0100 +++ new/scientific-0.3.4.0/src/Data/Scientific.hs 2015-09-30 09:16:10.000000000 +0200 @@ -2,6 +2,12 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE PatternGuards #-} + +#ifdef GENERICS +{-# LANGUAGE DeriveGeneric #-} +#endif -- | -- Module : Data.Scientific @@ -9,15 +15,16 @@ -- License : BSD3 -- Maintainer : Bas van Dijk <[email protected]> -- --- @Data.Scientific@ provides a space efficient and arbitrary precision --- scientific number type. --- --- 'Scientific' numbers are represented using --- <http://en.wikipedia.org/wiki/Scientific_notation scientific notation>. It --- uses an 'Integer' 'coefficient' @c@ and an 'Int' 'base10Exponent' @e@ (do --- note that since we're using an 'Int' to represent the exponent these numbers --- aren't truly arbitrary precision). A scientific number corresponds to the --- 'Fractional' number: @'fromInteger' c * 10 '^^' e@. +-- This module provides the number type 'Scientific'. Scientific numbers are +-- arbitrary precision and space efficient. They are represented using +-- <http://en.wikipedia.org/wiki/Scientific_notation scientific notation>. 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 @@ -42,7 +49,8 @@ -- 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. +-- 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: -- @@ -62,6 +70,8 @@ , isInteger -- * Conversions + , fromRationalRepetend + , toRationalRepetend , floatingOrInteger , toRealFloat , toBoundedRealFloat @@ -83,16 +93,20 @@ -- Imports ---------------------------------------------------------------------- +import Control.Exception (throw, ArithException(DivideByZero)) import Control.Monad (mplus) +import Control.Monad.ST (runST) import Control.DeepSeq (NFData(rnf)) -import Data.Array (Array, listArray, (!)) +import Data.Binary (Binary, get, put) import Data.Char (intToDigit, ord) import Data.Data (Data) import Data.Function (on) -import Data.Functor ((<$>)) import Data.Hashable (Hashable(..)) +import qualified Data.Map.Strict 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 @@ -102,12 +116,21 @@ 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, divInteger, quotInteger) + +import Utils (roundTo) + ---------------------------------------------------------------------- -- Type @@ -122,7 +145,7 @@ -- A scientific number with 'coefficient' @c@ and 'base10Exponent' @e@ -- corresponds to the 'Fractional' number: @'fromInteger' c * 10 '^^' e@ data Scientific = Scientific - { coefficient :: !Integer + { coefficient :: !Integer -- ^ The coefficient of a scientific number. -- -- Note that this number is not necessarily normalized, i.e. @@ -153,6 +176,16 @@ 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 (==) #-} @@ -178,23 +211,23 @@ instance Num Scientific where Scientific c1 e1 + Scientific c2 e2 - | e1 < e2 = scientific (c1 + c2*l) e1 - | otherwise = scientific (c1*r + 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 + | 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) + Scientific (c1 * c2) (e1 + e2) {-# INLINE (*) #-} abs (Scientific c e) = Scientific (abs c) e @@ -206,7 +239,7 @@ signum (Scientific c _) = Scientific (signum c) 0 {-# INLINE signum #-} - fromInteger i = scientific i 0 + fromInteger i = Scientific i 0 {-# INLINE fromInteger #-} -- | /WARNING:/ 'toRational' needs to compute the 'Integer' magnitude: @@ -231,8 +264,11 @@ realToFrac = toRealFloat :: Scientific -> Float #-} -- | /WARNING:/ '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. +-- when their outputs are <https://en.wikipedia.org/wiki/Repeating_decimal repeating decimals>. +-- +-- '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 #-} @@ -240,20 +276,170 @@ x / y = fromRational $ toRational x / toRational y {-# INLINE (/) #-} - fromRational rational = positivize (longDiv 0 0) (numerator rational) + 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 0 = Scientific c e longDiv !c !e !n -- TODO: Use a logarithm here! | n < d = longDiv (c * 10) (e - 1) (n * 10) - | otherwise = longDiv (c + q) e r - where - (q, r) = n `quotRem` d + | 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 +-- <https://en.wikipedia.org/wiki/Repeating_decimal repeating decimals> +-- 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: +-- <http://fiziko.bureau42.com/teaching_tidbits/turning_repeating_decimals_into_fractions.pdf turning_repeating_decimals_into_fractions.pdf> +-- 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: @@ -265,8 +451,8 @@ properFraction s@(Scientific c e) | e < 0 = if dangerouslySmall c e then (0, s) - else let (q, r) = c `quotRem` magnitude (-e) - in (fromInteger q, scientific r e) + else case c `quotRemInteger` magnitude (-e) of + (#q, r#) -> (fromInteger q, Scientific r e) | otherwise = (toIntegral s, 0) {-# INLINE properFraction #-} @@ -275,7 +461,7 @@ truncate = whenFloating $ \c e -> if dangerouslySmall c e then 0 - else fromInteger $ c `quot` magnitude (-e) + else fromInteger $ c `quotInteger` magnitude (-e) {-# INLINE truncate #-} -- | @'round' s@ returns the nearest integer to @s@; @@ -283,10 +469,11 @@ round = whenFloating $ \c e -> if dangerouslySmall c e then 0 - else let (q, r) = c `quotRem` magnitude (-e) + else let (#q, r#) = c `quotRemInteger` magnitude (-e) n = fromInteger q - m = if r < 0 then n - 1 else n + 1 - f = scientific r e + 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 @@ -300,8 +487,9 @@ then if c <= 0 then 0 else 1 - else let (q, r) = c `quotRem` magnitude (-e) - in fromInteger $! if r <= 0 then q else q + 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@ @@ -310,7 +498,7 @@ then if c < 0 then -1 else 0 - else fromInteger (c `div` magnitude (-e)) + else fromInteger (c `divInteger` magnitude (-e)) {-# INLINE floor #-} @@ -387,27 +575,35 @@ maxExpt :: Int maxExpt = 324 -expts10 :: Array Int Integer -expts10 = listArray (0, maxExpt) $ 1 : 10 : go 2 - where - go :: Int -> [Integer] - go !ix = xx : 10*xx : go (ix+2) +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 = expts10 ! half - + x = V.unsafeIndex expts10 half #if MIN_VERSION_base(4,5,0) - half = ix `unsafeShiftR` 1 + !half = ix `unsafeShiftR` 1 #else - half = ix `shiftR` 1 + !half = ix `shiftR` 1 #endif + go 2 -- | @magnitude e == 10 ^ e@ magnitude :: (Num a) => Int -> a -magnitude e | e <= maxExpt = cachedPow10 e - | otherwise = cachedPow10 maxExpt * 10 ^ (e - maxExpt) +magnitude e | e < maxExpt = cachedPow10 e + | otherwise = cachedPow10 hi * 10 ^ (e - hi) where - cachedPow10 p = fromInteger (expts10 ! p) + cachedPow10 p = fromInteger (V.unsafeIndex expts10 p) + + hi = maxExpt - 1 {-# INLINE magnitude #-} @@ -430,9 +626,9 @@ -- 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 fromNonNegRealFloat +fromFloatDigits = positivize fromPositiveRealFloat where - fromNonNegRealFloat r = go digits 0 0 + fromPositiveRealFloat r = go digits 0 0 where (digits, e) = Numeric.floatToDigits 10 r @@ -510,14 +706,15 @@ s' = normalize s dangerouslyBig = e > limit && - e > integerLog10' (max (abs $ toInteger (minBound :: i)) - (abs $ toInteger (maxBound :: i))) + e > integerLog10' (max (abs iMinBound) (abs iMaxBound)) fromIntegerBounded :: Integer -> Maybe i fromIntegerBounded i - | i < toInteger (minBound :: i) || - i > toInteger (maxBound :: i) = Nothing - | otherwise = Just $ fromInteger 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: @@ -596,8 +793,9 @@ else return (-e) (ReadP.satisfy isE >> - ((scientific signedCoeff . (expnt +)) <$> eP)) `mplus` - return (scientific signedCoeff expnt) + ((Scientific signedCoeff . (expnt +)) <$> eP)) `mplus` + return (Scientific signedCoeff expnt) + foldDigits :: (a -> Int -> a) -> a -> ReadP a foldDigits f z = do @@ -633,99 +831,109 @@ ---------------------------------------------------------------------- instance Show Scientific where - show = formatScientific Generic Nothing + 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 fmt decs scntfc@(Scientific c _) - | c < 0 = '-':doFmt fmt (toDecimalDigits (-scntfc)) - | otherwise = doFmt fmt (toDecimalDigits scntfc ) +formatScientific format mbDecs s + | coefficient s < 0 = '-':formatPositiveScientific (-s) + | otherwise = formatPositiveScientific s where - doFmt :: FPFormat -> ([Int], Int) -> String - doFmt format (is, e) = - let ds = map intToDigit 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' = show (e-1) in - case ds of - "0" -> "0.0e0" - [d] -> d : ".0e" ++ show_e' - (d:ds') -> d : '.' : ds' ++ "e" ++ show_e' - [] -> error "formatScientific/doFmt/FFExponent: []" - Just dec -> - 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) - Fixed -> - let - mk0 ls = case ls of { "" -> "0" ; _ -> ls} - in - case decs of - Nothing - | 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 - 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 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') - ----------------------------------------------------------------------- - -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) + 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 - (c,ds) = f (n-1) (even i) xs - i' = c + i + mk0 ls = case ls of { "" -> "0" ; _ -> ls} ---------------------------------------------------------------------- -- | Similar to 'Numeric.floatToDigits', @toDecimalDigits@ takes a --- non-negative 'Scientific' number, and returns a list of digits and +-- 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) @@ -740,18 +948,16 @@ -- 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], 0) -toDecimalDigits (Scientific c' e') = (is, n + e) +toDecimalDigits (Scientific 0 _) = ([0], 1) +toDecimalDigits (Scientific c' e') = + case normalizePositive c' e' of + (c, e) -> case reverseAndLength $ digits c of + (is, n) -> (is, n + e) where - Scientific c e = normalizePositive c' e' - - (is, n) = reverseAndLength $ digits c - digits :: Integer -> [Int] digits 0 = [] - digits i = fromIntegral r : digits q - where - (q, r) = i `quotRem` 10 + digits i = case i `quotRemInteger` 10 of + (# q, r #) -> fromIntegral r : digits q reverseAndLength :: [a] -> ([a], Int) reverseAndLength l = rev l [] 0 @@ -771,11 +977,11 @@ -- 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 + | c > 0 = case normalizePositive c e of (c', e') -> Scientific c' e' + | c < 0 = case normalizePositive (-c) e of (c', e') -> Scientific (-c') e' | otherwise {- c == 0 -} = Scientific 0 0 -normalizePositive :: Integer -> Int -> Scientific -normalizePositive c !e = case quotRem c 10 of - (q, 0) -> normalizePositive q (e+1) - _ -> Scientific c e +normalizePositive :: Integer -> Int -> (Integer, Int) +normalizePositive c !e = case quotRemInteger c 10 of + (# c', 0 #) -> normalizePositive c' (e+1) + _ -> (c, e) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/scientific-0.3.3.8/src/Data/Text/Lazy/Builder/Scientific.hs new/scientific-0.3.4.0/src/Data/Text/Lazy/Builder/Scientific.hs --- old/scientific-0.3.3.8/src/Data/Text/Lazy/Builder/Scientific.hs 2015-03-19 09:26:29.000000000 +0100 +++ new/scientific-0.3.4.0/src/Data/Text/Lazy/Builder/Scientific.hs 2015-09-30 09:16:10.000000000 +0200 @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, MagicHash, OverloadedStrings #-} +{-# LANGUAGE CPP, OverloadedStrings #-} module Data.Text.Lazy.Builder.Scientific ( scientificBuilder @@ -14,7 +14,6 @@ import Data.Text.Lazy.Builder (Builder, fromString, singleton, fromText) import Data.Text.Lazy.Builder.Int (decimal) import qualified Data.Text as T (replicate) -import GHC.Base (Int(I#), Char(C#), chr#, ord#, (+#)) #if MIN_VERSION_base(4,5,0) import Data.Monoid ((<>)) #else @@ -24,6 +23,8 @@ infixr 6 <> #endif +import Utils (roundTo, i2d) + -- | 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 @@ -94,29 +95,3 @@ d:ds' = map i2d (if ei > 0 then is' else 0:is') in singleton d <> (if null ds' then "" else singleton '.' <> fromString ds') - --- | Unsafe conversion for decimal digits. -{-# INLINE i2d #-} -i2d :: Int -> Char -i2d (I# i#) = C# (chr# (ord# '0'# +# i#)) - -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/scientific-0.3.3.8/src/Utils.hs new/scientific-0.3.4.0/src/Utils.hs --- old/scientific-0.3.3.8/src/Utils.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/scientific-0.3.4.0/src/Utils.hs 2015-09-30 09:16:10.000000000 +0200 @@ -0,0 +1,36 @@ +{-# 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# )) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/scientific-0.3.3.8/test/test.hs new/scientific-0.3.4.0/test/test.hs --- old/scientific-0.3.3.8/test/test.hs 2015-03-19 09:26:29.000000000 +0100 +++ new/scientific-0.3.4.0/test/test.hs 2015-09-30 09:16:10.000000000 +0200 @@ -10,7 +10,9 @@ module Main where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative +#endif import Control.Monad import Data.Int import Data.Word @@ -23,17 +25,21 @@ 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 -import qualified Data.Text.Lazy.Builder.Scientific as T #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" @@ -43,6 +49,11 @@ (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, ".")] @@ -61,16 +72,20 @@ , testGroup "Builder" [ testProperty "Text" $ \s -> - formatScientific B.Generic Nothing s == - TL.unpack (TLB.toLazyText $ T.formatScientificBuilder B.Generic Nothing s) + formatScientific Scientific.Generic Nothing s == + TL.unpack (TLB.toLazyText $ + T.formatScientificBuilder Scientific.Generic Nothing s) +#ifdef BYTESTRING_BUILDER , testProperty "ByteString" $ \s -> - formatScientific B.Generic Nothing s == - BLC8.unpack (B.toLazyByteString $ B.formatScientificBuilder B.Generic Nothing s) + formatScientific Scientific.Generic Nothing s == + BLC8.unpack (B.toLazyByteString $ + B.formatScientificBuilder Scientific.Generic Nothing s) +#endif ] , testProperty "formatScientific_fromFloatDigits" $ \(d::Double) -> - formatScientific B.Generic Nothing (Scientific.fromFloatDigits d) == + formatScientific Scientific.Generic Nothing (Scientific.fromFloatDigits d) == show d -- , testProperty "formatScientific_realToFrac" $ \(d::Double) -> @@ -141,7 +156,15 @@ ] , testGroup "Conversions" - [ testGroup "Float" $ conversionsProperties (undefined :: Float) + [ 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" @@ -342,10 +365,13 @@ instance QC.Arbitrary Scientific where arbitrary = QC.frequency - [ (70, scientific <$> QC.arbitrary <*> intGen) - , (20, scientific <$> QC.arbitrary <*> bigIntGen) - , (10, scientific <$> pure 0 <*> bigIntGen) - ] + [ (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)
