added shortest format mode to RealFloat that prints the shortest possible string

Author: BebeSparkelSparkel

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
+

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
+  , ..
+  }

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)
+              ]
+            ]
           ]
         ]
       ]

bytestring.cabal

@@ -181,6 +181,7 @@ test-suite bytestring-tests
                     deepseq,
                     ghc-prim,
                     QuickCheck,
+                    quickcheck-assertions,
                     tasty,
                     tasty-hunit,
                     tasty-quickcheck >= 0.8.1,

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]]
     ]