{-# LANGUAGE Safe #-}
module Data.Ratio
( Ratio
, Rational
, (%)
, numerator
, denominator
, approxRational
) where
import GHC.Real
approxRational :: (RealFrac a) => a -> a -> Rational
approxRational :: forall a. RealFrac a => a -> a -> Rational
approxRational a
rat a
eps =
forall {a}. Real a => a -> a -> Rational
simplest (forall a. Real a => a -> Rational
toRational a
rat forall a. Num a => a -> a -> a
- forall a. Real a => a -> Rational
toRational a
eps) (forall a. Real a => a -> Rational
toRational a
rat forall a. Num a => a -> a -> a
+ forall a. Real a => a -> Rational
toRational a
eps)
where
simplest :: a -> a -> Rational
simplest a
x a
y
| a
y forall a. Ord a => a -> a -> Bool
< a
x = a -> a -> Rational
simplest a
y a
x
| a
x forall a. Eq a => a -> a -> Bool
== a
y = Rational
xr
| a
x forall a. Ord a => a -> a -> Bool
> a
0 = forall {a}. Integral a => a -> a -> a -> a -> Ratio a
simplest' Integer
n Integer
d Integer
n' Integer
d'
| a
y forall a. Ord a => a -> a -> Bool
< a
0 = - forall {a}. Integral a => a -> a -> a -> a -> Ratio a
simplest' (-Integer
n') Integer
d' (-Integer
n) Integer
d
| Bool
otherwise = Integer
0 forall a. a -> a -> Ratio a
:% Integer
1
where xr :: Rational
xr = forall a. Real a => a -> Rational
toRational a
x
n :: Integer
n = forall a. Ratio a -> a
numerator Rational
xr
d :: Integer
d = forall a. Ratio a -> a
denominator Rational
xr
nd' :: Rational
nd' = forall a. Real a => a -> Rational
toRational a
y
n' :: Integer
n' = forall a. Ratio a -> a
numerator Rational
nd'
d' :: Integer
d' = forall a. Ratio a -> a
denominator Rational
nd'
simplest' :: a -> a -> a -> a -> Ratio a
simplest' a
n a
d a
n' a
d'
| a
r forall a. Eq a => a -> a -> Bool
== a
0 = a
q forall a. a -> a -> Ratio a
:% a
1
| a
q forall a. Eq a => a -> a -> Bool
/= a
q' = (a
qforall a. Num a => a -> a -> a
+a
1) forall a. a -> a -> Ratio a
:% a
1
| Bool
otherwise = (a
qforall a. Num a => a -> a -> a
*a
n''forall a. Num a => a -> a -> a
+a
d'') forall a. a -> a -> Ratio a
:% a
n''
where (a
q,a
r) = forall a. Integral a => a -> a -> (a, a)
quotRem a
n a
d
(a
q',a
r') = forall a. Integral a => a -> a -> (a, a)
quotRem a
n' a
d'
nd'' :: Ratio a
nd'' = a -> a -> a -> a -> Ratio a
simplest' a
d' a
r' a
d a
r
n'' :: a
n'' = forall a. Ratio a -> a
numerator Ratio a
nd''
d'' :: a
d'' = forall a. Ratio a -> a
denominator Ratio a
nd''