{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK prune #-}

-- |
-- A set of (very useful) utility functions, which notably include
-- 'display' and 'displayInformational'.
module Data.SigFig.Util where

import Data.BigDecimal (BigDecimal (..))
import Data.BigDecimal qualified as BD
import Data.SigFig.Types hiding (div)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Natural (naturalFromInteger)
import GHC.Real (Ratio ((:%)), (%))

-- | Get the rightmost significant decimal place given a number of
-- significant figures @sf@ and a BigDecimal @bd@. It is as if one
-- were calculating the value for a @Measured sf bd@.
--
-- A negative return value is allowed and meaningful.
--
-- >>> rightmostSignificantPlace 2 (BigDecimal 42 1)
-- -1
rightmostSignificantPlace :: Integer -> BigDecimal -> Integer
rightmostSignificantPlace :: Integer -> BigDecimal -> Integer
rightmostSignificantPlace Integer
sf BigDecimal
bd =
  let v' :: BigDecimal
v' = BigDecimal -> BigDecimal
BD.nf BigDecimal
bd
      dp :: Natural
dp = BigDecimal -> Natural
BD.scale BigDecimal
v'
      p :: Natural
p = BigDecimal -> Natural
BD.precision BigDecimal
v'
   in forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
p forall a. Num a => a -> a -> a
- Integer
sf forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
dp

-- | Force a given BigDecimal to have a certain number of significant
-- decimal places. A positive integer means to the left of decimal place,
-- negative means to the right.
--
-- ==== __Examples__
--
-- >>> forceDP (-2) (fromRational 123.456)
-- Measured {numSigFigs = 5, value = 123.46}
--
-- >>> forceDP 2 (fromRational 123.456)
-- Measured {numSigFigs = 1, value = 100}
forceDP :: Integer -> BigDecimal -> Term
forceDP :: Integer -> BigDecimal -> Term
forceDP Integer
dp BigDecimal
bd =
  let res :: BigDecimal
res = BigDecimal -> BigDecimal
BD.nf forall a b. (a -> b) -> a -> b
$ BigDecimal -> Integer -> BigDecimal
roundToPlace BigDecimal
bd Integer
dp
   in Integer -> BigDecimal -> Term
Measured (forall a. Ord a => a -> a -> a
max Integer
0 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (BigDecimal -> Natural
BD.precision BigDecimal
res) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (BigDecimal -> Natural
BD.scale BigDecimal
res) forall a. Num a => a -> a -> a
- Integer
dp) BigDecimal
res

-- | Force a given BigDecimal to have a certain number of significant figures.
-- A positive integer means to the left of decimal place, negative means to the right.
forceSF :: Integer -> BigDecimal -> Term
forceSF :: Integer -> BigDecimal -> Term
forceSF Integer
sf' BigDecimal
bd = Integer -> BigDecimal -> Term
Measured Integer
sf' forall b c a. (b -> c) -> (a -> b) -> a -> c
. BigDecimal -> Integer -> BigDecimal
roundToPlace BigDecimal
bd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BigDecimal -> Integer
rightmostSignificantPlace Integer
sf' forall a b. (a -> b) -> a -> b
$ BigDecimal
bd

-- | Round a BigDecimal to a specified decimal place. A positive integer means
-- to the left of decimal place, negative means to the right.
--
-- >>> roundToPlace (BigDecimal 421 1) (0)
-- 42
roundToPlace :: BigDecimal -> Integer -> BigDecimal
roundToPlace :: BigDecimal -> Integer -> BigDecimal
roundToPlace bd :: BigDecimal
bd@(BigDecimal Integer
v Natural
s) Integer
dp
  | Integer
dp forall a. Ord a => a -> a -> Bool
< Integer
0 = BigDecimal -> RoundingAdvice -> BigDecimal
BD.roundBD BigDecimal
bd forall a b. (a -> b) -> a -> b
$ Natural -> RoundingAdvice
BD.halfUp (forall a b. (Integral a, Num b) => a -> b
fromIntegral (- Integer
dp))
  | Bool
otherwise =
    let bd' :: BigDecimal
bd' = Integer -> Natural -> BigDecimal
BigDecimal Integer
v (Natural
s forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
dp)
     in BigDecimal -> RoundingAdvice -> BigDecimal
BD.roundBD BigDecimal
bd' (Natural -> RoundingAdvice
BD.halfUp Natural
0) forall a. Num a => a -> a -> a
* BigDecimal
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
dp

-- | Given a term, display it in the most convenient way possible. This means,
-- if the normal representation of the number accurately represents how many
-- significant figures it has, then display it normally. Adds trailing zeroes
-- if necessary to floats and opts for scientific notation if necessary.
--
-- ==== __Examples__
--
-- >>> display $ measured 3 200
-- "200."
--
-- >>> display $ measured 3 4
-- "4.00"
--
-- >>> display $ measured 2 400
-- "4.0 x 10^2"
--
-- >>> display $ measured 2 430
-- "430"
--
-- >>> display $ measured 1 1
-- "1"
--
-- >>> display $ constant (3 % 8)
-- "0.375"
--
-- >>> display $ constant (4 % 9)
-- "4/9"
--
-- >>> display $ measured 2 4.3
-- "4.3"
display :: Term -> Text
display :: Term -> Text
display (Measured Integer
sf BigDecimal
bd) = BigDecimal -> Text
format BigDecimal
bd
  where
    ssf :: Text
ssf = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Integer
sf
    format :: BigDecimal -> Text
    format :: BigDecimal -> Text
format BigDecimal
term' =
      let term :: BigDecimal
term@(BigDecimal Integer
v Natural
s') = BigDecimal -> BigDecimal
BD.nf BigDecimal
term'
          s :: Integer
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
s' :: Integer
          termText :: Text
termText = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ BigDecimal
term
          p :: Integer
p = forall a b. (Integral a, Num b) => a -> b
fromIntegral (BigDecimal -> Natural
BD.precision BigDecimal
term) :: Integer
          rsdp :: Integer
rsdp = Integer
p forall a. Num a => a -> a -> a
- Integer
sf forall a. Num a => a -> a -> a
- Integer
s
          rsd :: Integer
rsd = if Integer
sf forall a. Ord a => a -> a -> Bool
> Integer
p then Integer
0 else Integer
v forall a. Integral a => a -> a -> a
`div` (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
rsdp forall a. Num a => a -> a -> a
+ Integer
s)) forall a. Integral a => a -> a -> a
`mod` Integer
10
       in if Integer
rsd forall a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
|| Integer
rsdp forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& Integer
p forall a. Eq a => a -> a -> Bool
== Integer
1
            then Text
termText
            else
              if Integer
rsdp forall a. Ord a => a -> a -> Bool
>= Integer
1
                then let coef :: BigDecimal
coef = Integer -> Natural -> BigDecimal
BigDecimal Integer
v (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
s forall a. Num a => a -> a -> a
+ (Integer
p forall a. Num a => a -> a -> a
- Integer
1))) in BigDecimal -> Text
format BigDecimal
coef forall a. Semigroup a => a -> a -> a
<> Text
" x 10^" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ Integer
p forall a. Num a => a -> a -> a
- Integer
1)
                else
                  Text
termText
                    forall a. Semigroup a => a -> a -> a
<> (if Integer
s forall a. Ord a => a -> a -> Bool
> Integer
0 then Text
"" else Text
".")
                    forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
sf forall a. Num a => a -> a -> a
- Integer
p) Text
"0"
display (Constant v :: Rational
v@(Integer
a :% Integer
b)) =
  [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$
    if Integer -> Bool
isTerminating Integer
b
      then forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. BigDecimal -> BigDecimal
BD.nf forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
v
      else forall a. Show a => a -> [Char]
show Integer
a forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Integer
b

-- | Used in the CLI. Not super pretty but gets the job done in terms of displaying enough information.
--
-- ==== __Examples__
--
-- >>> displayFull (constant 3.45)
-- "3.45 (const)"
--
-- >>> displayFull (measured 3 8500)
-- "8.50 x 10^3 (3 s.f.)"
displayFull :: Term -> Text
displayFull :: Term -> Text
displayFull t :: Term
t@(Measured Integer
sf BigDecimal
bd) = Term -> Text
display Term
t forall a. Semigroup a => a -> a -> a
<> Text
annot
  where
    annot :: Text
annot = Text
" (" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Integer
sf) forall a. Semigroup a => a -> a -> a
<> Text
" s.f.)"
displayFull t :: Term
t@(Constant (Integer
a :% Integer
b)) = Term -> Text
display Term
t forall a. Semigroup a => a -> a -> a
<> Text
annot
  where
    annot :: Text
annot = if Integer -> Bool
isTerminating Integer
b then Text
" (const)" else Text
" (non-terminating const)"

-- | Given a term, return a tuple where the first element is the output of display and the second is an annotation of the type of value. Used in the API.
--
-- ==== __Examples__
--
-- >>> displayInformational $ constant 3
-- ("3","constant value")
--
-- >>> displayInformational $ measured 2 3.4
-- ("3.4","2 significant figures")
--
-- >>> displayInformational $ measured 3 3400
-- ("3.40 x 10^3","3 significant figures")
displayInformational :: Term -> (Text, Text)
displayInformational :: Term -> (Text, Text)
displayInformational t :: Term
t@(Measured Integer
sf BigDecimal
bd) = (Term -> Text
display Term
t, Text
annot)
  where
    annot :: Text
annot = [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Integer
sf) forall a. Semigroup a => a -> a -> a
<> Text
" significant figure" forall a. Semigroup a => a -> a -> a
<> if Integer
sf forall a. Eq a => a -> a -> Bool
/= Integer
1 then Text
"s" else forall a. Monoid a => a
mempty
displayInformational t :: Term
t@(Constant (Integer
a :% Integer
b)) = (Term -> Text
display Term
t, Text
annot)
  where
    annot :: Text
annot = if Integer -> Bool
isTerminating Integer
b then Text
"constant value" else Text
"constant, non-terminating decimal value"

-- | Given a denominator, tell if the decimal expansion of the fraction terminates.
-- Useful for telling whether a constant value is a terminating or non-terminating value.
-- But one should probably use 'displayInformational' to extract such information.
isTerminating :: Integer -> Bool
isTerminating :: Integer -> Bool
isTerminating = (forall a. Eq a => a -> a -> Bool
== Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> a -> a
stripFactor Integer
5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> a -> a
stripFactor Integer
2
  where
    stripFactor :: t -> t -> t
stripFactor t
d t
n = case t
n forall a. Integral a => a -> a -> (a, a)
`quotRem` t
d of
      (t
q, t
0) -> t -> t -> t
stripFactor t
d t
q
      (t, t)
_ -> t
n