added shortest format mode to RealFloat that prints the shortest poss…

…ible string
haskell · Jan 19, 2024 · e79e689 · e79e689
1 parent 67c4cb4
commit e79e689
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 1 deletion.
diff --git 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
@@ -251,6 +264,14 @@ 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 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

diff --git 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/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
@@ -61,6 +61,7 @@ import           Test.Tasty.QuickCheck
                    , (===), (.&&.), conjoin
                    , UnicodeString(..), NonNegative(..)
                    )
+import           Test.QuickCheck.Assertions ((?<=))
 import           QuickCheckUtils
 
 
@@ -743,6 +744,11 @@ testsFloating = testGroup "RealFloat"
           , ( 1.2345678      , "1.2345678" )
           , ( 1.23456735e-36 , "1.23456735e-36" )
           ]
+    , 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 "f2sPowersOf10" floatDec show $
           fmap asShowRef [read ("1.0e" ++ show x) :: Float | x <- [-46..39 :: Int]]
     ]
@@ -973,6 +979,11 @@ testsFloating = testGroup "RealFloat"
           , ( 549755813888.0e+3  , "5.49755813888e14" )
           , ( 8796093022208.0e+3 , "8.796093022208e15" )
           ]
+    , 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 "d2sPowersOf10" doubleDec show $
           fmap asShowRef [read ("1.0e" ++ show x) :: Double | x <- [-324..309 :: Int]]
     ]