diff --git a/Data/ByteString/Builder/RealFloat.hs b/Data/ByteString/Builder/RealFloat.hs index bd970c648..c80ec8d7b 100644 --- a/Data/ByteString/Builder/RealFloat.hs +++ b/Data/ByteString/Builder/RealFloat.hs @@ -78,11 +78,12 @@ module Data.ByteString.Builder.RealFloat , standardDefaultPrecision , scientific , generic + , shortest ) where import Data.ByteString.Builder.Internal (Builder) import qualified Data.ByteString.Builder.RealFloat.Internal as R -import Data.ByteString.Builder.RealFloat.Internal (FloatFormat(..), fScientific, fGeneric) +import Data.ByteString.Builder.RealFloat.Internal (FloatFormat(..), fScientific, fGeneric, fShortest, SpecialStrings(SpecialStrings)) import Data.ByteString.Builder.RealFloat.Internal (positiveZero, negativeZero) import qualified Data.ByteString.Builder.RealFloat.F2S as RF import qualified Data.ByteString.Builder.RealFloat.D2S as RD @@ -162,6 +163,18 @@ standardSpecialStrings = scientificSpecialStrings generic :: FloatFormat generic = fGeneric 'e' Nothing (0,7) standardSpecialStrings +-- | Standard or scientific notation depending on which uses the least number of charabers. +-- +-- @since ???? +shortest :: FloatFormat +shortest = fShortest 'e' SpecialStrings + { nan = "NaN" + , positiveInfinity = "Inf" + , negativeInfinity = "-Inf" + , positiveZero = "0" + , negativeZero = "-0" + } + -- TODO: support precision argument for FGeneric and FScientific -- | Returns a rendered Float. Returns the \'shortest\' representation in -- scientific notation and takes an optional precision argument in standard @@ -235,6 +248,7 @@ formatFloating :: forall a mw ew ei. , R.Mantissa mw , ToWord64 mw , R.DecimalLength mw + , BuildDigits mw -- exponent , ew ~ R.ExponentWord a , Integral ew @@ -251,6 +265,16 @@ formatFloating fmt f = case fmt of else sci eE FScientific {..} -> specialsOr specials $ sci eE FStandard {..} -> specialsOr specials $ std precision + FShortest {..} -> specialsOr specials + if e'' >= 0 && (olength + 2 >= e'' || olength == 1 && e'' <= 2) + || e'' < 0 && (olength + e'' >= (-3) || olength == 1 && e'' >= (-2)) + then if e'' >= 0 + then printSign f <> buildDigits (truncate $ abs f :: mw) + else std Nothing + else sci eE + where + e'' = R.toInt e + olength = R.decimalLength m where sci eE = BP.primBounded (R.toCharsScientific @a Proxy eE sign m e) () std precision = printSign f <> showStandard (toWord64 m) e' precision @@ -316,3 +340,7 @@ showStandard m e prec = ds = digits m digitsToBuilder = fmap (char7 . intToDigit) +class BuildDigits a where buildDigits :: a -> Builder +instance BuildDigits Word32 where buildDigits = BP.primBounded BP.word32Dec +instance BuildDigits Word64 where buildDigits = BP.primBounded BP.word64Dec + diff --git a/Data/ByteString/Builder/RealFloat/Internal.hs b/Data/ByteString/Builder/RealFloat/Internal.hs index dae38a50a..3e9fa4d9c 100644 --- a/Data/ByteString/Builder/RealFloat/Internal.hs +++ b/Data/ByteString/Builder/RealFloat/Internal.hs @@ -89,6 +89,7 @@ module Data.ByteString.Builder.RealFloat.Internal , FloatFormat(..) , fScientific , fGeneric + , fShortest , module Data.ByteString.Builder.RealFloat.TableGenerator ) where @@ -1001,6 +1002,10 @@ data FloatFormat , stdExpoRange :: (Int, Int) , specials :: SpecialStrings } + | FShortest + { eE :: Word8# + , specials :: SpecialStrings + } deriving Show fScientific :: Char -> SpecialStrings -> FloatFormat fScientific eE specials = FScientific @@ -1012,3 +1017,8 @@ fGeneric eE precision stdExpoRange specials = FGeneric { eE = asciiRaw $ ord eE , .. } +fShortest :: Char -> SpecialStrings -> FloatFormat +fShortest eE specials = FShortest + { eE = asciiRaw $ ord eE + , .. + } diff --git a/bench/BenchAll.hs b/bench/BenchAll.hs index 41950dd35..c66dd9b54 100644 --- a/bench/BenchAll.hs +++ b/bench/BenchAll.hs @@ -409,6 +409,22 @@ main = do , benchB "Double Average" doubleSpecials $ foldMap (formatDouble standardDefaultPrecision) ] ] + , bgroup "FShortest" + [ bgroup "Positive" + [ benchB "Float" floatPosData $ foldMap (formatFloat shortest) + , benchB "Double" doublePosData $ foldMap (formatDouble shortest) + , benchB "DoubleSmall" doublePosSmallData $ foldMap (formatDouble shortest) + ] + , bgroup "Negative" + [ benchB "Float" floatNegData $ foldMap (formatFloat shortest) + , benchB "Double" doubleNegData $ foldMap (formatDouble shortest) + , benchB "DoubleSmall" doubleNegSmallData $ foldMap (formatDouble shortest) + ] + , bgroup "Special" + [ benchB "Float Average" floatSpecials $ foldMap (formatFloat shortest) + , benchB "Double Average" doubleSpecials $ foldMap (formatDouble shortest) + ] + ] ] ] ] diff --git a/bytestring.cabal b/bytestring.cabal index 28a4d338a..949a313ed 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -181,6 +181,7 @@ test-suite bytestring-tests deepseq, ghc-prim, QuickCheck, + quickcheck-assertions, tasty, tasty-hunit, tasty-quickcheck >= 0.8.1, diff --git a/tests/builder/Data/ByteString/Builder/Tests.hs b/tests/builder/Data/ByteString/Builder/Tests.hs index f35bcfc3f..0c2618fe3 100644 --- a/tests/builder/Data/ByteString/Builder/Tests.hs +++ b/tests/builder/Data/ByteString/Builder/Tests.hs @@ -61,6 +61,7 @@ import Test.Tasty.QuickCheck , (===), (.&&.), conjoin , UnicodeString(..), NonNegative(..) ) +import Test.QuickCheck.Assertions ((?<=)) import QuickCheckUtils @@ -743,6 +744,22 @@ testsFloating = testGroup "RealFloat" , ( 1.2345678 , "1.2345678" ) , ( 1.23456735e-36 , "1.23456735e-36" ) ] + , testGroup "FShortest" + [ testProperty "prints equivalent value" \f -> read (LC.unpack $ toLazyByteString $ formatFloat shortest f) === f + , testProperty "shortest length always less than or equal to standard or scientific length outputs" \f -> let + sh = L.length $ toLazyByteString $ formatFloat shortest f + std = L.length $ toLazyByteString $ formatFloat standardDefaultPrecision f + sci = L.length $ toLazyByteString $ formatFloat scientific f + in sh ?<= min std sci + , testMatches "no .0 for whole numbers" (formatFloat shortest) (show . truncate) + [ (1, "1") + , (-1, "-1") + , (10, "10") + , (-10, "-10") + , (15, "15") + , (-15, "-15") + ] + ] , testMatches "f2sPowersOf10" floatDec show $ fmap asShowRef [read ("1.0e" ++ show x) :: Float | x <- [-46..39 :: Int]] ] @@ -973,6 +990,22 @@ testsFloating = testGroup "RealFloat" , ( 549755813888.0e+3 , "5.49755813888e14" ) , ( 8796093022208.0e+3 , "8.796093022208e15" ) ] + , testGroup "FShortest" + [ testProperty "prints equivalent value" \f -> read (LC.unpack $ toLazyByteString $ formatDouble shortest f) === f + , testProperty "shortest length always less than or equal to standard or scientific length outputs" \f -> let + sh = L.length $ toLazyByteString $ formatDouble shortest f + std = L.length $ toLazyByteString $ formatDouble standardDefaultPrecision f + sci = L.length $ toLazyByteString $ formatDouble scientific f + in sh ?<= min std sci + , testMatches "no .0 for whole numbers" (formatDouble shortest) (show . truncate) + [ (1, "1") + , (-1, "-1") + , (10, "10") + , (-10, "-10") + , (15, "15") + , (-15, "-15") + ] + ] , testMatches "d2sPowersOf10" doubleDec show $ fmap asShowRef [read ("1.0e" ++ show x) :: Double | x <- [-324..309 :: Int]] ]