diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/formatn.cabal b/formatn.cabal --- a/formatn.cabal +++ b/formatn.cabal @@ -1,64 +1,45 @@ -cabal-version: 2.4 -name: formatn -version: 0.0.1 -synopsis: Number text formatting. -description: This package provides support for common number formatting patterns. - . - == Usage - . - > import Data.FormatN - . - See doctests for functionality and range. +cabal-version: 2.4 +name: formatn +version: 0.1.0 +synopsis: Formatting of doubles. +description: + This package provides support for number formatting styles, especially styles involving significant figure calculations. + . + == Usage + . + >>> import Data.FormatN + >>> comma (Just 3) 1234 + 1,230 -category: Development -homepage: https://github.com/tonyday567/formatn#readme -bug-reports: https://github.com/tonyday567/formatn/issues -author: Tony Day -maintainer: tonyday567@gmail.com -copyright: 2016 Tony Day -license: BSD-3-Clause -license-file: LICENSE -build-type: Simple +category: Development +homepage: https://github.com/tonyday567/formatn#readme +bug-reports: https://github.com/tonyday567/formatn/issues +author: Tony Day +maintainer: tonyday567@gmail.com +copyright: 2016 Tony Day +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple source-repository head - type: git + type: git location: https://github.com/tonyday567/formatn library - hs-source-dirs: - src + hs-source-dirs: src default-extensions: ghc-options: - -Wall - -Wcompat - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wredundant-constraints - build-depends: - attoparsec >= 0.13 && < 0.14, - base >=4.7 && <5, - containers >= 0.6, - foldl >= 1.4, - generic-lens >= 1.2 && < 3.0, - numhask >= 0.7 && < 0.8, - scientific >= 0.3, - tdigest >= 0.2, - text >= 1.2, - transformers >= 0.5 - exposed-modules: - Data.FormatN - other-modules: - default-language: Haskell2010 + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints -fwrite-ide-info + -hiedir=.hie -test-suite test - type: exitcode-stdio-1.0 - main-is: test.hs - hs-source-dirs: - test - default-extensions: build-depends: - base >=4.7 && <5, - doctest >= 0.16 && < 0.18, - formatn, - numhask >= 0.7 && < 0.8, - default-language: Haskell2010 + , base >=4.7 && <5 + , containers ^>=0.6 + , text ^>=1.2 + + -- uncomment to run cabal-docspec --check-properties + -- QuickCheck, + exposed-modules: Data.FormatN + other-modules: + default-language: Haskell2010 diff --git a/src/Data/FormatN.hs b/src/Data/FormatN.hs --- a/src/Data/FormatN.hs +++ b/src/Data/FormatN.hs @@ -1,63 +1,153 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RebindableSyntax #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE StrictData #-} {-# OPTIONS_GHC -Wall #-} -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} -{-# OPTIONS_GHC -fno-warn-type-defaults #-} --- | Formatting of 'Double's. +-- | Text formatting of 'Double's. +-- +-- In particular, the library provides functionality to calculate and display a fixed number of for a variety of different number formatting styles. +-- +-- +-- Some similar libraries that may be better suited for different use cases include: +-- +-- Flexible formatters. These libraries provide more flexibility around formatting options, but do not have a concept of significance: +-- +-- - and in base. +-- - +-- - +-- +-- has similar functionality but is not native haskell and I wanted to do some tweaking to defaults. It's probably safer and faster. +-- +-- seems to be much more about doing computation taking rounding into account, compared with the much simpler task of pretty printing a number. +-- +-- This library could have just provided an ability to compute a significant figure version of a number and then use these other libraries, but the round trip (from Double to SigFig to Double) introduces errors (eg the least significant figure goes from being a '4' to a '3999999' via float maths). module Data.FormatN - ( FormatN (..), + ( -- * Usage + -- $usage + + -- * FormatN + FormatN (..), defaultFormatN, - fromFormatN, - toFormatN, + formatN, + formatNs, + precision, + + -- * SigFig + SigFig (..), + SigFigSign (..), + toSigFig, + fromSigFig, + + -- * formatters fixed, + expt, decimal, prec, comma, - expt, dollar, - formatN, - precision, - formatNs, + percent, + showOr, ) where -import Data.Generics.Labels () -import Data.List (nub) -import Data.Scientific +import Data.Bifunctor +import Data.Bool +import Data.Containers.ListUtils (nubOrd) +import Data.Foldable +import Data.Maybe +import Data.Text (Text, pack) import qualified Data.Text as Text -import NumHask.Prelude +import GHC.Generics hiding (prec) +import Numeric +import Prelude +-- $setup +-- >>> import Data.FormatN +-- >>> xs = [(-1),0,1,1.01,1.02,1.1,1.2] +-- +-- >>> fixed (Just 2) <$> xs +-- ["-1.00","0.00","1.00","1.01","1.02","1.10","1.20"] +-- +-- >>> decimal (Just 2) <$> xs +-- ["-1.0","0.0","1.0","1.0","1.0","1.1","1.2"] +-- +-- >>> comma (Just 3) <$> xs +-- ["-1.00","0.00","1.00","1.01","1.02","1.10","1.20"] +-- +-- comma (Just 3) . (1e3*) <$> xs +-- ["-1,000","0.00","1,000","1,010","1,020","1,100","1,200"] +-- +-- comma (Just 3) . (1e-3*) <$> xs +-- ["-0.00100","0.00","0.00100","0.00101","0.00102","0.00110","0.00120"] +-- +-- >>> comma (Just 3) . (1e-6*) <$> xs +-- ["-1.00e-6","0.00","1.00e-6","1.01e-6","1.02e-6","1.10e-6","1.20e-6"] +-- +-- >>> comma (Just 2) . (1e3*) <$> xs +-- ["-1,000","0.0","1,000","1,000","1,000","1,100","1,200"] +-- +-- >>> precision comma (Just 2) $ (1e3*) <$> [0,1,1.01,1.02,1.1,1.2] +-- ["0.00","1,000","1,010","1,020","1,100","1,200"] + +-- $usage +-- >>> import Data.FormatN +-- >>> xs = [(-1),0,1,1.01,1.02,1.1,1.2] +-- >>> fixed (Just 2) <$> xs +-- ["-1.00","0.00","1.00","1.01","1.02","1.10","1.20"] +-- +-- >>> decimal (Just 2) <$> xs +-- ["-1.0","0.0","1.0","1.0","1.0","1.1","1.2"] +-- +-- formatn is used in the library to automate consistent number formatting across different scales. +-- +-- >>> comma (Just 3) <$> xs +-- ["-1.00","0.00","1.00","1.01","1.02","1.10","1.20"] +-- +-- >>> comma (Just 3) . (1e3*) <$> xs +-- ["-1,000","0.00","1,000","1,010","1,020","1,100","1,200"] +-- +-- >>> comma (Just 3) . (1e-3*) <$> xs +-- ["-0.00100","0.00","0.00100","0.00101","0.00102","0.00110","0.00120"] +-- +-- >>> comma (Just 3) . (1e-6*) <$> xs +-- ["-1.00e-6","0.00","1.00e-6","1.01e-6","1.02e-6","1.10e-6","1.20e-6"] +-- +-- Using significant figures actually changes numbers - numbers that were slightly different end up being (and looking like) the same. 'precision' increases the number of significant figures to get around this. +-- +-- >>> comma (Just 2) . (1e3*) <$> xs +-- ["-1,000","0.0","1,000","1,000","1,000","1,100","1,200"] +-- +-- >>> precision comma (Just 2) $ (1e3*) <$> [0,1,1.01,1.02,1.1,1.2] +-- ["0.00","1,000","1,010","1,020","1,100","1,200"] +-- +-- Also note the clunkiness of the treatment of zero. It is problematic to default format zero consistently. + -- | Wrapper for the various formatting options. -- --- >>> defaultFormatN --- FormatComma 2 +-- Nothing in the context of these constructors means do not perform and significant figure adjustments to the numbers (or decimal figures with respect to FormatFixed). data FormatN - = FormatFixed Int - | FormatDecimal Int - | FormatComma Int - | FormatExpt Int - | FormatPrec Int - | FormatDollar Int - | FormatPercent Int + = FormatFixed (Maybe Int) + | FormatDecimal (Maybe Int) + | FormatComma (Maybe Int) + | FormatExpt (Maybe Int) + | FormatPrec (Maybe Int) + | FormatDollar (Maybe Int) + | FormatPercent (Maybe Int) | FormatNone deriving (Eq, Show, Generic) -- | The official format +-- +-- >>> defaultFormatN +-- FormatComma (Just 2) defaultFormatN :: FormatN -defaultFormatN = FormatComma 2 +defaultFormatN = FormatComma (Just 2) --- | make text +-- | run a 'FormatN' +-- +-- >>> formatN defaultFormatN 1234 +-- "1,200" formatN :: FormatN -> Double -> Text formatN (FormatFixed n) x = fixed n x formatN (FormatDecimal n) x = decimal n x @@ -68,145 +158,219 @@ formatN (FormatPercent n) x = percent n x formatN FormatNone x = pack (show x) --- | type textifier -fromFormatN :: (IsString s) => FormatN -> s -fromFormatN (FormatFixed _) = "Fixed" -fromFormatN (FormatDecimal _) = "Decimal" -fromFormatN (FormatComma _) = "Comma" -fromFormatN (FormatExpt _) = "Expt" -fromFormatN (FormatPrec _) = "Prec" -fromFormatN (FormatDollar _) = "Dollar" -fromFormatN (FormatPercent _) = "Percent" -fromFormatN FormatNone = "None" +-- | Format to x decimal places with no significant figure rounding. +-- +-- >>> fixed (Just 2) 100 +-- "100.00" +-- +-- >>> fixed (Just 2) 0.001 +-- "0.00" +fixed :: Maybe Int -> Double -> Text +fixed n x = pack $ showFFloat n x "" --- | type readifier -toFormatN :: (Eq s, IsString s) => s -> Int -> FormatN -toFormatN "Fixed" n = FormatFixed n -toFormatN "Decimal" n = FormatDecimal n -toFormatN "Comma" n = FormatComma n -toFormatN "Expt" n = FormatExpt n -toFormatN "Prec" n = FormatPrec n -toFormatN "Dollar" n = FormatDollar n -toFormatN "Percent" n = FormatPercent n -toFormatN "None" _ = FormatNone -toFormatN _ _ = FormatNone +-- | Decomposition of a Double into the components that are needed to determine significant figure formatting. +-- +-- eliding type changes, the relationship between a Double and a SigFig is: +-- +-- \[ +-- x == sign * figures * 10^{exponent} +-- \] +data SigFig = SigFig + { -- | sign + sign :: SigFigSign, + -- | significant figures expressed as an Integer + figures :: Integer, + -- | the power of 10 exponent given figures. + exponent :: Int + } + deriving (Eq, Show) --- | to x decimal places +-- | Sign component +data SigFigSign = SigFigNeg | SigFigPos deriving (Eq, Show) + +sfsign :: SigFigSign -> String +sfsign s = bool "" "-" (s == SigFigNeg) + +-- | convert from a Double to a 'SigFig' -- --- >>> fixed 2 1 --- "1.00" +-- >>> toSigFig (Just 2) 1234 +-- SigFig {sign = SigFigPos, figures = 12, exponent = 2} -- --- >>> fixed 2 0.001 --- "0.00" -fixed :: Int -> Double -> Text -fixed x n = pack $ formatScientific Fixed (Just x) (fromFloatDigits n) +-- prop> \x -> let (SigFig s fs e) = toSigFig Nothing x in let x' = ((if (s==SigFigNeg) then (-1.0) else 1.0) * fromIntegral fs * 10.0**fromIntegral e) in (x==0 || abs (x/x'-1) < 1e-6) +toSigFig :: Maybe Int -> Double -> SigFig +toSigFig n x = SigFig s fs' expo + where + (s, (floatfs, floate)) = bool (SigFigPos, floatToDigits 10 x) (SigFigNeg, floatToDigits 10 (-x)) (x < 0) + -- floatToDigits 10 0 == ([0],0) floatToDigits 10 1 == ([1],1) + floate' = bool floate (floate + 1) (x == 0) + nsig = fromMaybe (length floatfs) n + -- pad with extra zeros if less figures than requested + (floatfs', e) = + bool + (floatfs, floate' - length floatfs) + (floatfs <> replicate (nsig - length floatfs) 0, floate' - nsig) + (length floatfs < nsig) + (fs0, fs1) = splitAt nsig floatfs' + -- reconstitute number to get rounding right at the least significance point + fs = + round $ + (fromIntegral $ foldl' (\x' a -> x' * 10 + a) 0 fs0 :: Double) + + fromIntegral (foldl' (\x' a -> x' * 10 + a) 0 fs1) / (10.0 ^ (length fs1 :: Int)) + -- rounding can bump significant figures by 1 eg 99(.9999) ==> 100 + (fs', expo) = + bool + (fs, e + length floatfs' - nsig) + (fs `div` 10, e + length floatfs' - nsig + 1) + (length (show fs) > nsig) --- | scientific exponential +-- | convert from a 'SigFig' to a Double -- --- >>> expt 2 1234 --- "1.23e3" -expt :: Int -> Double -> Text -expt x n = pack $ formatScientific Exponent (Just x) (fromFloatDigits n) +-- >>> fromSigFig (SigFig SigFigPos 12 2) +-- 1200.0 +-- +-- @fromSigFig . toSigFig Nothing@ may not be isomorphic +fromSigFig :: SigFig -> Double +fromSigFig (SigFig s fs e) = bool 1 (-1) (s == SigFigNeg) * fromIntegral fs * 10 ** fromIntegral e --- | round to n significant figures +exptR :: SigFig -> Text +exptR (SigFig s i e) = pack $ sfsign s <> i'' <> "e" <> show e' + where + i'' + | length i' == 1 = i' + | otherwise = take 1 i' <> "." <> drop 1 i' + i' = show i + e' = e + length i' - 1 + +-- | Format in exponential style, maybe with significant figure rounding. -- --- >>> roundSig 2 1234 --- 1230.0 +-- >>> expt Nothing 1245 +-- "1.245e3" -- --- >>> roundSig 2 0.001234 --- 1.23e-3 -roundSig :: Int -> Double -> Scientific -roundSig n x = scientific r' (e - length ds0) +-- >>> expt (Just 3) 1245 +-- "1.24e3" +-- +-- >>> expt (Just 3) 0.1245 +-- "1.24e-1" +expt :: Maybe Int -> Double -> Text +expt n x = exptR (toSigFig n x) + +decimalR :: SigFig -> Text +decimalR (SigFig s xs e) = pack $ sfsign s <> t where - (ds, e) = toDecimalDigits $ fromFloatDigits x - (ds0, ds1) = splitAt (n + 1) ds - r = - (fromIntegral $ foldl' (\x a -> x * 10 + a) 0 ds0 :: Double) - + fromIntegral (foldl' (\x a -> x * 10 + a) 0 ds1) / (10.0 ^ (length ds1 :: Int)) - r' = round r :: Integer + xs' = show xs + nsf = length xs' + extrasf = bool (-(e + nsf)) (-(e + nsf)) (xs == 0) + oversf = length xs' + e + t + | e >= 0 = xs' <> replicate e '0' + | e <= -nsf = "0." <> replicate extrasf '0' <> xs' + | otherwise = take oversf xs' <> "." <> drop oversf xs' --- | format numbers between 0.001 and 1,000,000 using digit and comma notation and exponential outside this range, with x significant figures. +-- | Format in decimal style, and maybe round to n significant figures. -- --- >>> prec 1 0.00234 +-- >>> decimal Nothing 1.2345e-2 +-- "0.012345" +-- +-- >>> decimal (Just 2) 0.012345 +-- "0.012" +-- +-- >>> decimal (Just 2) 12345 +-- "12000" +decimal :: Maybe Int -> Double -> Text +decimal n x = decimalR (toSigFig n x) + +-- | Format between 0.001 and 1,000,000 using decimal style and exponential style outside this range. +-- +-- >>> prec (Just 2) 0.00234 -- "0.0023" -- --- >>> prec 1 0.000023 +-- >>> prec (Just 2) 0.000023 -- "2.3e-5" -- --- >>> prec 1 123 +-- >>> prec (Just 2) 123 -- "120" -- --- >>> prec 1 123456 +-- >>> prec (Just 2) 123456 -- "120000" -- --- >>> prec 1 1234567 +-- >>> prec (Just 2) 1234567 -- "1.2e6" -prec :: Int -> Double -> Text -prec n x - | x < 0 = "-" <> prec n (- x) - | x == 0 = "0" - | x < 0.001 = expt n x - | x > 1e6 = expt n x - | otherwise = decimal n (toRealFloat x') - where - x' = maybe fromFloatDigits roundSig (Just n) x - --- | round to n significant figures and always use decimal notation --- --- >>> decimal 2 0.000001234 --- "0.00000123" --- --- >>> decimal 2 1234567 --- "1230000" -decimal :: Int -> Double -> Text -decimal n x = x'' +prec :: Maybe Int -> Double -> Text +prec n x = bool (go x) ("-" <> go (-x)) (x < 0) where - x' = pack $ formatScientific Fixed Nothing $ maybe fromFloatDigits roundSig (Just n) x - x'' = (\x -> bool x' (fst x) (snd x == ".0")) $ Text.breakOn "." x' + go x' = + bool + ( bool + (decimal n x') + (expt n x') + (x' > 1e6) + ) + (expt n x') + (x' < 0.001 && (x /= 0)) --- | add commas format for numbers above 1,000 but below 1 million, otherwise use prec. +-- | Format using comma separators for numbers above 1,000 but below 1 million, otherwise use prec style. -- --- >>> comma 2 1234 +-- >>> comma (Just 3) 1234 -- "1,230" -comma :: Int -> Double -> Text +comma :: Maybe Int -> Double -> Text comma n x - | x < 0 = "-" <> comma n (- x) + | x < 0 = "-" <> comma n (-x) | x < 1000 || x > 1e6 = prec n x | otherwise = addcomma (prec n x) where - addcomma x = uncurry (<>) . first (Text.reverse . Text.intercalate "," . Text.chunksOf 3 . Text.reverse) $ Text.breakOn "." x + addcomma = + uncurry (<>) + . first (Text.reverse . Text.intercalate "," . Text.chunksOf 3 . Text.reverse) + . Text.breakOn "." --- | dollars and cents, always decimal notation +-- | Format as dollars, always using comma notation -- --- >>> dollar 2 1234 +-- >>> dollar (Just 3) 1234 -- "$1,230" -- --- >>> dollar 2 0.01234 --- "$0.0123" -dollar :: Int -> Double -> Text +-- >>> dollar (Just 2) 0.01234 +-- "$0.012" +dollar :: Maybe Int -> Double -> Text dollar n x - | x < 0 = "-" <> dollar n (- x) + | x < 0 = "-" <> dollar n (-x) | otherwise = "$" <> comma n x --- | fixed percent, always decimal notation +-- | Format as a percentage using decimal style. -- --- >>> percent 2 0.001234 --- "0.123%" -percent :: Int -> Double -> Text +-- >>> percent (Just 2) 0.001234 +-- "0.12%" +percent :: Maybe Int -> Double -> Text percent n x = (<> "%") $ decimal n (100 * x) --- | Provide formatted text for a list of numbers so that they are just distinguished. 'precision commas 2 ticks' means use as much precision as is needed for them to be distinguished, but with at least 2 significant figures. -precision :: (Int -> Double -> Text) -> Int -> [Double] -> [Text] -precision f n0 xs = - precLoop f n0 xs +precision_ :: (Maybe Int -> Double -> Text) -> Int -> [Double] -> [Text] +precision_ f n0 xs = + precLoop n0 xs where - precLoop f' n xs' = - let s = f' n <$> xs' - in if s == nub s || n > 4 - then s - else precLoop f' (n + 1) xs' + precLoop n xs' = + let s = f (Just n) <$> xs' + in bool (precLoop (1 + n) xs') s (s == nubOrd s || n > 4) --- | Consistently format a list of doubles. +-- | Provide formatted text for a list of numbers so that they are just distinguished. +-- +-- For example, __@precision comma (Just 2)@__ means use as much significant figures as is needed for the numbers to be distinguished on rendering, but with at least 2 significant figures. +-- +-- The difference between this and __@fmap (comma (Just 2))@__ can be seen in these examples: +-- +-- >>> precision comma (Just 2) [0,1,1.01,1.02,1.1,1.2] +-- ["0.00","1.00","1.01","1.02","1.10","1.20"] +-- +-- >>> fmap (comma (Just 2)) [0,1,1.01,1.02,1.1,1.2] +-- ["0.0","1.0","1.0","1.0","1.1","1.2"] +precision :: (Maybe Int -> Double -> Text) -> Maybe Int -> [Double] -> [Text] +precision f n xs = + case n of + Nothing -> f Nothing <$> xs + Just n' -> precision_ f n' xs + +-- | Consistently format a list of numbers via using 'precision'. +-- +-- >>> formatNs defaultFormatN [0,1,1.01,1.02,1.1,1.2] +-- ["0.00","1.00","1.01","1.02","1.10","1.20"] formatNs :: FormatN -> [Double] -> [Text] formatNs (FormatFixed n) xs = precision fixed n xs formatNs (FormatDecimal n) xs = precision decimal n xs @@ -216,3 +380,10 @@ formatNs (FormatDollar n) xs = precision dollar n xs formatNs (FormatPercent n) xs = precision percent n xs formatNs FormatNone xs = pack . show <$> xs + +-- | Format with the shorter of show and formatN. +showOr :: FormatN -> Double -> Text +showOr f x = bool (bool f' (pack s') (Text.length (pack s') < Text.length f')) "0" (x < 1e-6 && x > -1e-6) + where + f' = formatN f x + s' = show x diff --git a/test/test.hs b/test/test.hs deleted file mode 100644 --- a/test/test.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE RebindableSyntax #-} -{-# OPTIONS_GHC -Wall #-} -{-# OPTIONS_GHC -fno-warn-unused-imports #-} - -module Main where - -import NumHask.Prelude -import Test.DocTest - -main :: IO () -main = - doctest - [ "src/Data/FormatN.hs" - ]