|
| 1 | +-- | |
| 2 | +-- Module : Data.ByteString.Builder.RealFloat |
| 3 | +-- Copyright : (c) Lawrence Wu 2021 |
| 4 | +-- License : BSD-style |
| 5 | +-- Maintainer : lawrencejwu@gmail.com |
| 6 | +-- |
| 7 | +-- Floating point formatting for @Bytestring.Builder@ |
| 8 | +-- |
| 9 | +-- This module primarily exposes `floatDec` and `doubleDec` which do the |
| 10 | +-- equivalent of converting through @'Data.ByteString.Builder.string7' . 'show'@. |
| 11 | +-- |
| 12 | +-- It also exposes `formatFloat` and `formatDouble` with a similar API as |
| 13 | +-- `GHC.Float.formatRealFloat`. |
| 14 | +-- |
| 15 | +-- NB: The float-to-string conversions exposed by this module match `show`'s |
| 16 | +-- output (specifically with respect to default rounding and length). In |
| 17 | +-- particular, there are boundary cases where the closest and \'shortest\' |
| 18 | +-- string representations are not used. Mentions of \'shortest\' in the docs |
| 19 | +-- below are with this caveat. |
| 20 | +-- |
| 21 | +-- For example, for fidelity, we match `show` on the output below. |
| 22 | +-- |
| 23 | +-- >>> show (1.0e23 :: Float) |
| 24 | +-- "1.0e23" |
| 25 | +-- >>> show (1.0e23 :: Double) |
| 26 | +-- "9.999999999999999e22" |
| 27 | +-- >>> floatDec 1.0e23 |
| 28 | +-- "1.0e23" |
| 29 | +-- >>> doubleDec 1.0e23 |
| 30 | +-- "9.999999999999999e22" |
| 31 | +-- |
| 32 | +-- Simplifying, we can build a shorter, lossless representation by just using |
| 33 | +-- @"1.0e23"@ since the floating point values that are 1 ULP away are |
| 34 | +-- |
| 35 | +-- >>> showHex (castDoubleToWord64 1.0e23) [] |
| 36 | +-- "44b52d02c7e14af6" |
| 37 | +-- >>> castWord64ToDouble 0x44b52d02c7e14af5 |
| 38 | +-- 9.999999999999997e22 |
| 39 | +-- >>> castWord64ToDouble 0x44b52d02c7e14af6 |
| 40 | +-- 9.999999999999999e22 |
| 41 | +-- >>> castWord64ToDouble 0x44b52d02c7e14af7 |
| 42 | +-- 1.0000000000000001e23 |
| 43 | +-- |
| 44 | +-- In particular, we could use the exact boundary if it is the shortest |
| 45 | +-- representation and the original floating number is even. To experiment with |
| 46 | +-- the shorter rounding, refer to |
| 47 | +-- `Data.ByteString.Builder.RealFloat.Internal.acceptBounds`. This will give us |
| 48 | +-- |
| 49 | +-- >>> floatDec 1.0e23 |
| 50 | +-- "1.0e23" |
| 51 | +-- >>> doubleDec 1.0e23 |
| 52 | +-- "1.0e23" |
| 53 | +-- |
| 54 | +-- For more details, please refer to the |
| 55 | +-- <https://dl.acm.org/doi/10.1145/3192366.3192369 Ryu paper>. |
| 56 | + |
| 57 | + |
| 58 | +module Data.ByteString.Builder.RealFloat |
| 59 | + ( floatDec |
| 60 | + , doubleDec |
| 61 | + |
| 62 | + -- * Custom formatting |
| 63 | + , formatFloat |
| 64 | + , formatDouble |
| 65 | + , FloatFormat |
| 66 | + , standard |
| 67 | + , standardDefaultPrecision |
| 68 | + , scientific |
| 69 | + , generic |
| 70 | + ) where |
| 71 | + |
| 72 | +import Data.ByteString.Builder.Internal (Builder) |
| 73 | +import qualified Data.ByteString.Builder.RealFloat.Internal as R |
| 74 | +import qualified Data.ByteString.Builder.RealFloat.F2S as RF |
| 75 | +import qualified Data.ByteString.Builder.RealFloat.D2S as RD |
| 76 | +import qualified Data.ByteString.Builder.Prim as BP |
| 77 | +import GHC.Float (roundTo) |
| 78 | +import GHC.Word (Word64) |
| 79 | +import GHC.Show (intToDigit) |
| 80 | + |
| 81 | +-- | Returns a rendered Float. Matches `show` in displaying in standard or |
| 82 | +-- scientific notation |
| 83 | +-- |
| 84 | +-- @ |
| 85 | +-- floatDec = 'formatFloat' 'generic' |
| 86 | +-- @ |
| 87 | +{-# INLINABLE floatDec #-} |
| 88 | +floatDec :: Float -> Builder |
| 89 | +floatDec = formatFloat generic |
| 90 | + |
| 91 | +-- | Returns a rendered Double. Matches `show` in displaying in standard or |
| 92 | +-- scientific notation |
| 93 | +-- |
| 94 | +-- @ |
| 95 | +-- doubleDec = 'formatDouble' 'generic' |
| 96 | +-- @ |
| 97 | +{-# INLINABLE doubleDec #-} |
| 98 | +doubleDec :: Double -> Builder |
| 99 | +doubleDec = formatDouble generic |
| 100 | + |
| 101 | +-- | Format type for use with `formatFloat` and `formatDouble`. |
| 102 | +data FloatFormat = MkFloatFormat FormatMode (Maybe Int) |
| 103 | + |
| 104 | +-- | Standard notation with `n` decimal places |
| 105 | +standard :: Int -> FloatFormat |
| 106 | +standard n = MkFloatFormat FStandard (Just n) |
| 107 | + |
| 108 | +-- | Standard notation with the \'default precision\' (decimal places matching `show`) |
| 109 | +standardDefaultPrecision :: FloatFormat |
| 110 | +standardDefaultPrecision = MkFloatFormat FStandard Nothing |
| 111 | + |
| 112 | +-- | Scientific notation with \'default precision\' (decimal places matching `show`) |
| 113 | +scientific :: FloatFormat |
| 114 | +scientific = MkFloatFormat FScientific Nothing |
| 115 | + |
| 116 | +-- | Standard or scientific notation depending on the exponent. Matches `show` |
| 117 | +generic :: FloatFormat |
| 118 | +generic = MkFloatFormat FGeneric Nothing |
| 119 | + |
| 120 | +-- | ByteString float-to-string format |
| 121 | +data FormatMode |
| 122 | + = FScientific -- ^ scientific notation |
| 123 | + | FStandard -- ^ standard notation with `Maybe Int` digits after the decimal |
| 124 | + | FGeneric -- ^ dispatches to scientific or standard notation based on the exponent |
| 125 | + deriving Show |
| 126 | + |
| 127 | +-- TODO: support precision argument for FGeneric and FScientific |
| 128 | +-- | Returns a rendered Float. Returns the \'shortest\' representation in |
| 129 | +-- scientific notation and takes an optional precision argument in standard |
| 130 | +-- notation. Also see `floatDec`. |
| 131 | +-- |
| 132 | +-- With standard notation, the precision argument is used to truncate (or |
| 133 | +-- extend with 0s) the \'shortest\' rendered Float. The \'default precision\' does |
| 134 | +-- no such modifications and will return as many decimal places as the |
| 135 | +-- representation demands. |
| 136 | +-- |
| 137 | +-- e.g |
| 138 | +-- |
| 139 | +-- >>> formatFloat (standard 1) 1.2345e-2 |
| 140 | +-- "0.0" |
| 141 | +-- >>> formatFloat (standard 10) 1.2345e-2 |
| 142 | +-- "0.0123450000" |
| 143 | +-- >>> formatFloat standardDefaultPrecision 1.2345e-2 |
| 144 | +-- "0.01234" |
| 145 | +-- >>> formatFloat scientific 12.345 |
| 146 | +-- "1.2345e1" |
| 147 | +-- >>> formatFloat generic 12.345 |
| 148 | +-- "12.345" |
| 149 | +{-# INLINABLE formatFloat #-} |
| 150 | +formatFloat :: FloatFormat -> Float -> Builder |
| 151 | +formatFloat (MkFloatFormat fmt prec) = \f -> |
| 152 | + let (RF.FloatingDecimal m e) = RF.f2Intermediate f |
| 153 | + e' = R.int32ToInt e + R.decimalLength9 m in |
| 154 | + case fmt of |
| 155 | + FGeneric -> |
| 156 | + case specialStr f of |
| 157 | + Just b -> b |
| 158 | + Nothing -> |
| 159 | + if e' >= 0 && e' <= 7 |
| 160 | + then sign f `mappend` showStandard (R.word32ToWord64 m) e' prec |
| 161 | + else BP.primBounded (R.toCharsScientific (f < 0) m e) () |
| 162 | + FScientific -> RF.f2s f |
| 163 | + FStandard -> |
| 164 | + case specialStr f of |
| 165 | + Just b -> b |
| 166 | + Nothing -> sign f `mappend` showStandard (R.word32ToWord64 m) e' prec |
| 167 | + |
| 168 | +-- TODO: support precision argument for FGeneric and FScientific |
| 169 | +-- | Returns a rendered Double. Returns the \'shortest\' representation in |
| 170 | +-- scientific notation and takes an optional precision argument in standard |
| 171 | +-- notation. Also see `doubleDec`. |
| 172 | +-- |
| 173 | +-- With standard notation, the precision argument is used to truncate (or |
| 174 | +-- extend with 0s) the \'shortest\' rendered Float. The \'default precision\' |
| 175 | +-- does no such modifications and will return as many decimal places as the |
| 176 | +-- representation demands. |
| 177 | +-- |
| 178 | +-- e.g |
| 179 | +-- |
| 180 | +-- >>> formatDouble (standard 1) 1.2345e-2 |
| 181 | +-- "0.0" |
| 182 | +-- >>> formatDouble (standard 10) 1.2345e-2 |
| 183 | +-- "0.0123450000" |
| 184 | +-- >>> formatDouble standardDefaultPrecision 1.2345e-2 |
| 185 | +-- "0.01234" |
| 186 | +-- >>> formatDouble scientific 12.345 |
| 187 | +-- "1.2345e1" |
| 188 | +-- >>> formatDouble generic 12.345 |
| 189 | +-- "12.345" |
| 190 | +{-# INLINABLE formatDouble #-} |
| 191 | +formatDouble :: FloatFormat -> Double -> Builder |
| 192 | +formatDouble (MkFloatFormat fmt prec) = \f -> |
| 193 | + let (RD.FloatingDecimal m e) = RD.d2Intermediate f |
| 194 | + e' = R.int32ToInt e + R.decimalLength17 m in |
| 195 | + case fmt of |
| 196 | + FGeneric -> |
| 197 | + case specialStr f of |
| 198 | + Just b -> b |
| 199 | + Nothing -> |
| 200 | + if e' >= 0 && e' <= 7 |
| 201 | + then sign f `mappend` showStandard m e' prec |
| 202 | + else BP.primBounded (R.toCharsScientific (f < 0) m e) () |
| 203 | + FScientific -> RD.d2s f |
| 204 | + FStandard -> |
| 205 | + case specialStr f of |
| 206 | + Just b -> b |
| 207 | + Nothing -> sign f `mappend` showStandard m e' prec |
| 208 | + |
| 209 | +-- | Char7 encode a 'Char'. |
| 210 | +{-# INLINE char7 #-} |
| 211 | +char7 :: Char -> Builder |
| 212 | +char7 = BP.primFixed BP.char7 |
| 213 | + |
| 214 | +-- | Char7 encode a 'String'. |
| 215 | +{-# INLINE string7 #-} |
| 216 | +string7 :: String -> Builder |
| 217 | +string7 = BP.primMapListFixed BP.char7 |
| 218 | + |
| 219 | +-- | Encodes a `-` if input is negative |
| 220 | +sign :: RealFloat a => a -> Builder |
| 221 | +sign f = if f < 0 then char7 '-' else mempty |
| 222 | + |
| 223 | +-- | Special rendering for Nan, Infinity, and 0. See |
| 224 | +-- RealFloat.Internal.NonNumbersAndZero |
| 225 | +specialStr :: RealFloat a => a -> Maybe Builder |
| 226 | +specialStr f |
| 227 | + | isNaN f = Just $ string7 "NaN" |
| 228 | + | isInfinite f = Just $ sign f `mappend` string7 "Infinity" |
| 229 | + | isNegativeZero f = Just $ string7 "-0.0" |
| 230 | + | f == 0 = Just $ string7 "0.0" |
| 231 | + | otherwise = Nothing |
| 232 | + |
| 233 | +-- | Returns a list of decimal digits in a Word64 |
| 234 | +digits :: Word64 -> [Int] |
| 235 | +digits w = go [] w |
| 236 | + where go ds 0 = ds |
| 237 | + go ds c = let (q, r) = R.dquotRem10 c |
| 238 | + in go ((R.word64ToInt r) : ds) q |
| 239 | + |
| 240 | +-- | Show a floating point value in standard notation. Based on GHC.Float.showFloat |
| 241 | +showStandard :: Word64 -> Int -> Maybe Int -> Builder |
| 242 | +showStandard m e prec = |
| 243 | + case prec of |
| 244 | + Nothing |
| 245 | + | e <= 0 -> char7 '0' |
| 246 | + `mappend` char7 '.' |
| 247 | + `mappend` string7 (replicate (-e) '0') |
| 248 | + `mappend` mconcat (digitsToBuilder ds) |
| 249 | + | otherwise -> |
| 250 | + let f 0 s rs = mk0 (reverse s) `mappend` char7 '.' `mappend` mk0 rs |
| 251 | + f n s [] = f (n-1) (char7 '0':s) [] |
| 252 | + f n s (r:rs) = f (n-1) (r:s) rs |
| 253 | + in f e [] (digitsToBuilder ds) |
| 254 | + Just p |
| 255 | + | e >= 0 -> |
| 256 | + let (ei, is') = roundTo 10 (p' + e) ds |
| 257 | + (ls, rs) = splitAt (e + ei) (digitsToBuilder is') |
| 258 | + in mk0 ls `mappend` mkDot rs |
| 259 | + | otherwise -> |
| 260 | + let (ei, is') = roundTo 10 p' (replicate (-e) 0 ++ ds) |
| 261 | + -- ds' should always be non-empty but use redundant pattern |
| 262 | + -- matching to silence warning |
| 263 | + ds' = if ei > 0 then is' else 0:is' |
| 264 | + (ls, rs) = splitAt 1 $ digitsToBuilder ds' |
| 265 | + in mk0 ls `mappend` mkDot rs |
| 266 | + where p' = max p 0 |
| 267 | + where |
| 268 | + mk0 ls = case ls of [] -> char7 '0'; _ -> mconcat ls |
| 269 | + mkDot rs = if null rs then mempty else char7 '.' `mappend` mconcat rs |
| 270 | + ds = digits m |
| 271 | + digitsToBuilder = fmap (char7 . intToDigit) |
| 272 | + |
0 commit comments