percent-format-0.0.1: src/Text/PercentFormat/Quotient.hs
-- |
-- Module : Text.PercentFormat.Quotient
-- Copyright : (c) 2018 Rudy Matela
-- License : 3-Clause BSD (see the file LICENSE)
-- Maintainer : Rudy Matela <rudy@matela.com.br>
--
-- The 'Quotient' datatype. Similar to 'Rational' but allows @Infinity@ and
-- @NaN@.
module Text.PercentFormat.Quotient
( Quotient
, (%)
, infinity
, nan
, isInfinite
, isNaN
, readQ
, maybeReadQ
, digits
, fracDigits
)
where
import Prelude hiding (isInfinite, isNaN)
import Data.Char (isDigit)
import Data.Maybe (fromMaybe)
import Data.List (findIndex)
import qualified Data.Ratio as R
import Text.PercentFormat.Utils
-- | Our own Ratio type that allows Infinity and NaN
data Quotient = Integer :% Integer
infixl 7 :%
-- | 'Eq' instance for 'Quotient'. Follows the identity property except for
-- NaN which is different from itself (this is consistent with 'Float' &
-- 'Double' behaviour).
instance Eq Quotient where
(0 :% 0) == _ = False
_ == (0 :% 0) = False
(x :% y) == (x' :% y') = (x * y') == (x' * y)
-- | 'Ord' instance for 'Quotient'. Follows the regular order properties
-- except for NaN. When NaN is present in any of the operands of 'compare',
-- 'GT' is returned (consistent with 'Float' & 'Double').
instance Ord Quotient where
(0 :% 0) `compare` _ = GT
_ `compare` (0 :% 0) = GT
(x :% y) `compare` (x' :% y') = (x * y') `compare` (x' * y)
instance Show Quotient where
showsPrec d (0 :% 0) = showString "NaN"
showsPrec d (x :% 0) | x < 0 = showParen (d > 6) $ showString "-Infinity"
| otherwise = showString "Infinity"
showsPrec d (x :% y) = showParen (d > 7)
$ showsPrec 7 x . showString " % " . showsPrec 7 y
-- | Smart-constructor for Quotients
(%) :: Integer -> Integer -> Quotient
0 % 0 = 0 :% 0 -- NaN
x % 0 = signum x :% 0 -- (+/-) Infinity
x % y = (x * signum y `quot` d) :% (abs y `quot` d)
where
d = gcd x y
infixl 7 %
-- | Infinity.
infinity :: Quotient
infinity = 1 % 0
-- | Not a number @(0 / 0)@.
nan :: Quotient
nan = 0 % 0
-- | Returns whether a given quotient is an infinity (+/-).
isInfinite :: Quotient -> Bool
isInfinite q = q == infinity || q == (-infinity)
-- | Returns if the quotient is not a number.
isNaN :: Quotient -> Bool
isNaN q = q /= q
instance Num Quotient where
negate (x :% y) = negate x % y
(x :% y) + (x' :% y') = (x * y' + x' * y) % (y * y')
(x :% y) * (x' :% y') = (x * x') % (y * y')
abs (x :% y) = abs x % abs y
signum (x :% y) = signum x * signum y % 1
fromInteger = (% 1)
instance Fractional Quotient where
recip (x :% y) = y % x
fromRational q = R.numerator q % R.denominator q
instance Real Quotient where
toRational (x :% y) = x R.% y
instance RealFrac Quotient where
properFraction (x :% y) = (fromInteger q, r % y)
where (q,r) = quotRem x y
-- TODO: change this ugly ad-hoc implementation into something that uses
-- readsPrec and related functions
maybeReadQ :: String -> Maybe Quotient
maybeReadQ "Infinity" = Just infinity
maybeReadQ "NaN" = Just nan
maybeReadQ "inf" = Just infinity -- for Hugs
maybeReadQ "nan" = Just nan -- for Hugs
maybeReadQ ('-':s) = negate <$> maybeReadQ s
where
f <$> Nothing = Nothing
f <$> (Just x) = Just (f x)
maybeReadQ ('(':s) = case span (/= ')') s of
(s',')':s'') -> maybeReadQ (s' ++ s'') -- ugly!
_ -> Nothing
maybeReadQ (d:s) | not (isDigit d) = Nothing
maybeReadQ etc = Just $
case span isDigit etc of
("",_) -> error "readQ: the impossible happened"
(i,'.':etc) -> case span isDigit etc of
(j,'e':'-':e:tc) | isDigit e ->
read (i++j) % 10 ^ (length j + read (e:takeWhile isDigit tc))
(j,'e':e:tc) | isDigit e ->
read (i++j) * 10 ^ (read (e:takeWhile isDigit tc)) % 10 ^ length j
(j,etc) -> read (i++j) % 10 ^ length j
(i,'%':e:tc) | isDigit e -> case span isDigit (e:tc) of
(j,etc) -> read i % read j
(i,' ':'%':' ':e:tc) | isDigit e -> case span isDigit (e:tc) of
(j,etc) -> read i % read j
(i,etc) -> read i % 1
readQ :: String -> Quotient
readQ = fromMaybe (error "No number to read") . maybeReadQ
-- | Given a quotient (rational number),
-- returns a tuple with
-- its integer part,
-- its fractional digits and
-- the period size (last fractional digits).
-- The signal is ignored.
--
-- > > digits 10 (1234567 / 100)
-- > Right ([1,2,3,4,5],[6,7],[])
-- > > digits 10 (1/3)
-- > Right ([0],[3],1)
-- > > digits 10 (1/6)
-- > Right ([0],[1,6],1)
-- > > digits 10 (1/7)
-- > Right ([0],[1,4,2,8,5,7],6)
-- > > digits 10 (1/11)
-- > Right ([0],[0,9],2)
-- > digits 10 (1/12)
-- > Right ([0],[0,8,3],1)
-- > > digits 10 (1/13)
-- > Right ([0],[0,7,6,9,2,3],6)
-- > > digits 10 123
-- > Right ([1,2,3],[],[])
-- > > digits 10 (-4/3)
-- > Right ([1],[],[3])
-- > > digits 10 (-1/3)
-- > Right ([0],[],[3])
digits :: Int -> Quotient -> Either String ([Int],[Int],[Int])
digits b (0 :% 0) = Left "NaN"
digits b (n :% 0) = Left "Infinity"
digits b q = Right (ids,fds,pds)
where
(i,q') = properFraction q
(fds,pds) = fracDigits b q'
ids = case integerToDigits b i of
[] -> [0]
ds -> ds
-- | Givent a base, returns the fractional digits of a Quotient (including a
-- period if present).
--
-- > > fracDigits 10 (123 / 100)
-- > ([2,3],[])
-- > > fracDigits 10 (12345 / 100)
-- > ([4,5],[])
-- > > fracDigits 10 (12345 / 10)
-- > ([5],[])
-- > > fracDigits 10 (100 / 10)
-- > ([],[])
-- > > fracDigits 10 (1 / 3)
-- > ([],[3])
-- > > fracDigits 10 (1 / 7)
-- > ([],[1,4,2,8,5,7])
fracDigits :: Int -> Quotient -> ([Int],[Int])
fracDigits b q | q < 0 = fracDigits b (abs q)
fracDigits b q | q >= 1 = fracDigits b (snd $ properFraction q)
fracDigits b q = let (fds,psz) = fun [] q
fsz = length fds - psz
in splitAt fsz fds
where
fun :: [(Integer,Integer)] -> Quotient -> ([Int],Int)
fun hist (0 :% _) = ([],0)
fun hist (x :% y) = case findIndex (==(x,y)) hist of
Nothing -> (fromInteger q:fds,psz)
Just i -> ([],i+1)
where
(q,r) = (x * toInteger b) `quotRem` y
(fds,psz) = fun ((x,y):hist) (r % y)