{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ParallelListComp #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Data.ExactPi
(
ExactPi(..),
approximateValue,
isZero,
isExact,
isExactZero,
isExactOne,
areExactlyEqual,
isExactInteger,
toExactInteger,
isExactRational,
toExactRational,
rationalApproximations,
getRationalLimit
)
where
import Data.Monoid
import Data.Ratio ((%), numerator, denominator)
import Data.Semigroup
import Prelude
data ExactPi = Exact Integer Rational
| Approximate (forall a.Floating a => a)
approximateValue :: Floating a => ExactPi -> a
approximateValue :: ExactPi -> a
approximateValue (Exact Integer
z Rational
q) = (a
forall a. Floating a => a
pi a -> Integer -> a
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Integer
z) a -> a -> a
forall a. Num a => a -> a -> a
* (Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
q)
approximateValue (Approximate forall a. Floating a => a
x) = a
forall a. Floating a => a
x
isZero :: ExactPi -> Bool
isZero :: ExactPi -> Bool
isZero (Exact Integer
_ Rational
0) = Bool
True
isZero (Approximate forall a. Floating a => a
x) = Double
forall a. Floating a => a
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== (Double
0 :: Double)
isZero ExactPi
_ = Bool
False
isExact :: ExactPi -> Bool
isExact :: ExactPi -> Bool
isExact (Exact Integer
_ Rational
_) = Bool
True
isExact ExactPi
_ = Bool
False
isExactZero :: ExactPi -> Bool
isExactZero :: ExactPi -> Bool
isExactZero (Exact Integer
_ Rational
0) = Bool
True
isExactZero ExactPi
_ = Bool
False
isExactOne :: ExactPi -> Bool
isExactOne :: ExactPi -> Bool
isExactOne (Exact Integer
0 Rational
1) = Bool
True
isExactOne ExactPi
_ = Bool
False
areExactlyEqual :: ExactPi -> ExactPi -> Bool
areExactlyEqual :: ExactPi -> ExactPi -> Bool
areExactlyEqual (Exact Integer
z1 Rational
q1) (Exact Integer
z2 Rational
q2) = (Integer
z1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
z2 Bool -> Bool -> Bool
&& Rational
q1 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
q2) Bool -> Bool -> Bool
|| (Rational
q1 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 Bool -> Bool -> Bool
&& Rational
q2 Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0)
areExactlyEqual ExactPi
_ ExactPi
_ = Bool
False
isExactInteger :: ExactPi -> Bool
isExactInteger :: ExactPi -> Bool
isExactInteger (Exact Integer
0 Rational
q) | Rational -> Integer
forall a. Ratio a -> a
denominator Rational
q Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Bool
True
isExactInteger ExactPi
_ = Bool
False
toExactInteger :: ExactPi -> Maybe Integer
toExactInteger :: ExactPi -> Maybe Integer
toExactInteger (Exact Integer
0 Rational
q) | Rational -> Integer
forall a. Ratio a -> a
denominator Rational
q Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
numerator Rational
q
toExactInteger ExactPi
_ = Maybe Integer
forall a. Maybe a
Nothing
isExactRational :: ExactPi -> Bool
isExactRational :: ExactPi -> Bool
isExactRational (Exact Integer
0 Rational
_) = Bool
True
isExactRational ExactPi
_ = Bool
False
toExactRational :: ExactPi -> Maybe Rational
toExactRational :: ExactPi -> Maybe Rational
toExactRational (Exact Integer
0 Rational
q) = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
q
toExactRational ExactPi
_ = Maybe Rational
forall a. Maybe a
Nothing
rationalApproximations :: ExactPi -> [Rational]
rationalApproximations :: ExactPi -> [Rational]
rationalApproximations (Approximate forall a. Floating a => a
x) = [Double -> Rational
forall a. Real a => a -> Rational
toRational (Double
forall a. Floating a => a
x :: Double)]
rationalApproximations (Exact Integer
_ Rational
0) = [Rational
0]
rationalApproximations (Exact Integer
0 Rational
q) = [Rational
q]
rationalApproximations (Exact Integer
z Rational
q)
| Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
z = [Rational
q Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
10005Rational -> Integer -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
k Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
cRational -> Integer -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
z | Rational
c <- [Rational]
chudnovsky]
| Bool
otherwise = [Rational
q Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
10005Rational -> Integer -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
k Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
cRational -> Integer -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
z Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r | Rational
c <- [Rational]
chudnovsky | Rational
r <- [Rational]
rootApproximation]
where k :: Integer
k = Integer
z Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2
chudnovsky :: [Rational]
chudnovsky :: [Rational]
chudnovsky = [Rational
426880 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
s | Rational
s <- [Rational]
partials]
where lk :: [Rational]
lk = (Rational -> Rational) -> Rational -> [Rational]
forall a. (a -> a) -> a -> [a]
iterate (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
545140134) Rational
13591409
xk :: [Rational]
xk = (Rational -> Rational) -> Rational -> [Rational]
forall a. (a -> a) -> a -> [a]
iterate (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*(-Rational
262537412640768000)) Rational
1
kk :: [Integer]
kk = (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
12) Integer
6
mk :: [Rational]
mk = Rational
1Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: [Rational
m Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* ((Integer
kInteger -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
3::Int) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
16Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
k) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
3::Int)) | Rational
m <- [Rational]
mk | Integer
k <- [Integer]
kk | Integer
n <- [Integer
0..]]
values :: [Rational]
values = [Rational
m Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
l Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
x | Rational
m <- [Rational]
mk | Rational
l <- [Rational]
lk | Rational
x <- [Rational]
xk]
partials :: [Rational]
partials = (Rational -> Rational -> Rational) -> [Rational] -> [Rational]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+) [Rational]
values
getRationalLimit :: Fractional a => (a -> a -> Bool) -> [Rational] -> a
getRationalLimit :: (a -> a -> Bool) -> [Rational] -> a
getRationalLimit a -> a -> Bool
cmp = [a] -> a
go ([a] -> a) -> ([Rational] -> [a]) -> [Rational] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> a) -> [Rational] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Rational -> a
forall a. Fractional a => Rational -> a
fromRational
where go :: [a] -> a
go (a
x:a
y:[a]
xs)
| a -> a -> Bool
cmp a
x a
y = a
y
| Bool
otherwise = [a] -> a
go (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
go [a
x] = a
x
go [a]
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"did not converge"
rootApproximation :: [Rational]
rootApproximation :: [Rational]
rootApproximation = ([Rational] -> Rational) -> [[Rational]] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map [Rational] -> Rational
forall a. [a] -> a
head ([[Rational]] -> [Rational])
-> ([Rational] -> [[Rational]]) -> [Rational] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Rational] -> [Rational]) -> [Rational] -> [[Rational]]
forall a. (a -> a) -> a -> [a]
iterate (Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
drop Int
4) ([Rational] -> [Rational]) -> [Rational] -> [Rational]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer -> Integer -> [Rational]
forall t. Integral t => t -> t -> t -> t -> t -> [Ratio t]
go Integer
1 Integer
0 Integer
100 Integer
1 Integer
40
where
go :: t -> t -> t -> t -> t -> [Ratio t]
go t
pk' t
qk' t
pk t
qk t
a = (t
pk t -> t -> Ratio t
forall a. Integral a => a -> a -> Ratio a
% t
qk)Ratio t -> [Ratio t] -> [Ratio t]
forall a. a -> [a] -> [a]
: t -> t -> t -> t -> t -> [Ratio t]
go t
pk t
qk (t
pk' t -> t -> t
forall a. Num a => a -> a -> a
+ t
at -> t -> t
forall a. Num a => a -> a -> a
*t
pk) (t
qk' t -> t -> t
forall a. Num a => a -> a -> a
+ t
at -> t -> t
forall a. Num a => a -> a -> a
*t
qk) (t
240t -> t -> t
forall a. Num a => a -> a -> a
-t
a)
instance Show ExactPi where
show :: ExactPi -> [Char]
show (Exact Integer
z Rational
q) | Integer
z Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = [Char]
"Exactly " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> [Char]
forall a. Show a => a -> [Char]
show Rational
q
| Integer
z Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = [Char]
"Exactly pi * " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> [Char]
forall a. Show a => a -> [Char]
show Rational
q
| Bool
otherwise = [Char]
"Exactly pi^" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
z [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" * " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> [Char]
forall a. Show a => a -> [Char]
show Rational
q
show (Approximate forall a. Floating a => a
x) = [Char]
"Approximately " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
forall a. Show a => a -> [Char]
show (Double
forall a. Floating a => a
x :: Double)
instance Num ExactPi where
fromInteger :: Integer -> ExactPi
fromInteger Integer
n = Integer -> Rational -> ExactPi
Exact Integer
0 (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
n)
(Exact Integer
z1 Rational
q1) * :: ExactPi -> ExactPi -> ExactPi
* (Exact Integer
z2 Rational
q2) = Integer -> Rational -> ExactPi
Exact (Integer
z1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
z2) (Rational
q1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
q2)
(Exact Integer
_ Rational
0) * ExactPi
_ = ExactPi
0
ExactPi
_ * (Exact Integer
_ Rational
0) = ExactPi
0
ExactPi
x * ExactPi
y = (forall a. Floating a => a) -> ExactPi
Approximate ((forall a. Floating a => a) -> ExactPi)
-> (forall a. Floating a => a) -> ExactPi
forall a b. (a -> b) -> a -> b
$ ExactPi -> a
forall a. Floating a => ExactPi -> a
approximateValue ExactPi
x a -> a -> a
forall a. Num a => a -> a -> a
* ExactPi -> a
forall a. Floating a => ExactPi -> a
approximateValue ExactPi
y
(Exact Integer
z1 Rational
q1) + :: ExactPi -> ExactPi -> ExactPi
+ (Exact Integer
z2 Rational
q2) | Integer
z1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
z2 = Integer -> Rational -> ExactPi
Exact Integer
z1 (Rational
q1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
q2)
ExactPi
x + ExactPi
y = (forall a. Floating a => a) -> ExactPi
Approximate ((forall a. Floating a => a) -> ExactPi)
-> (forall a. Floating a => a) -> ExactPi
forall a b. (a -> b) -> a -> b
$ ExactPi -> a
forall a. Floating a => ExactPi -> a
approximateValue ExactPi
x a -> a -> a
forall a. Num a => a -> a -> a
+ ExactPi -> a
forall a. Floating a => ExactPi -> a
approximateValue ExactPi
y
abs :: ExactPi -> ExactPi
abs (Exact Integer
z Rational
q) = Integer -> Rational -> ExactPi
Exact Integer
z (Rational -> Rational
forall a. Num a => a -> a
abs Rational
q)
abs (Approximate forall a. Floating a => a
x) = (forall a. Floating a => a) -> ExactPi
Approximate ((forall a. Floating a => a) -> ExactPi)
-> (forall a. Floating a => a) -> ExactPi
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
forall a. Floating a => a
x
signum :: ExactPi -> ExactPi
signum (Exact Integer
_ Rational
q) = Integer -> Rational -> ExactPi
Exact Integer
0 (Rational -> Rational
forall a. Num a => a -> a
signum Rational
q)
signum (Approximate forall a. Floating a => a
x) = (forall a. Floating a => a) -> ExactPi
Approximate ((forall a. Floating a => a) -> ExactPi)
-> (forall a. Floating a => a) -> ExactPi
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
signum a
forall a. Floating a => a
x
negate :: ExactPi -> ExactPi
negate ExactPi
x = (Integer -> Rational -> ExactPi
Exact Integer
0 (-Rational
1)) ExactPi -> ExactPi -> ExactPi
forall a. Num a => a -> a -> a
* ExactPi
x
instance Fractional ExactPi where
fromRational :: Rational -> ExactPi
fromRational = Integer -> Rational -> ExactPi
Exact Integer
0
recip :: ExactPi -> ExactPi
recip (Exact Integer
z Rational
q) = Integer -> Rational -> ExactPi
Exact (Integer -> Integer
forall a. Num a => a -> a
negate Integer
z) (Rational -> Rational
forall a. Fractional a => a -> a
recip Rational
q)
recip (Approximate forall a. Floating a => a
x) = (forall a. Floating a => a) -> ExactPi
Approximate (a -> a
forall a. Fractional a => a -> a
recip a
forall a. Floating a => a
x)
instance Floating ExactPi where
pi :: ExactPi
pi = Integer -> Rational -> ExactPi
Exact Integer
1 Rational
1
exp :: ExactPi -> ExactPi
exp ExactPi
x | ExactPi -> Bool
isExactZero ExactPi
x = ExactPi
1
| Bool
otherwise = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
exp ExactPi
x
log :: ExactPi -> ExactPi
log (Exact Integer
0 Rational
1) = ExactPi
0
log ExactPi
x = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
log ExactPi
x
sin :: ExactPi -> ExactPi
sin = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
sin
cos :: ExactPi -> ExactPi
cos = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
cos
tan :: ExactPi -> ExactPi
tan = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
tan
asin :: ExactPi -> ExactPi
asin = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
asin
atan :: ExactPi -> ExactPi
atan = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
atan
acos :: ExactPi -> ExactPi
acos = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
acos
sinh :: ExactPi -> ExactPi
sinh = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
sinh
cosh :: ExactPi -> ExactPi
cosh = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
cosh
tanh :: ExactPi -> ExactPi
tanh = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
tanh
asinh :: ExactPi -> ExactPi
asinh = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
asinh
acosh :: ExactPi -> ExactPi
acosh = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
acosh
atanh :: ExactPi -> ExactPi
atanh = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
atanh
approx1 :: (forall a.Floating a => a -> a) -> ExactPi -> ExactPi
approx1 :: (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
f ExactPi
x = (forall a. Floating a => a) -> ExactPi
Approximate (a -> a
forall a. Floating a => a -> a
f (ExactPi -> a
forall a. Floating a => ExactPi -> a
approximateValue ExactPi
x))
instance Semigroup ExactPi where
<> :: ExactPi -> ExactPi -> ExactPi
(<>) = ExactPi -> ExactPi -> ExactPi
forall a. Monoid a => a -> a -> a
mappend
instance Monoid ExactPi where
mempty :: ExactPi
mempty = ExactPi
1
mappend :: ExactPi -> ExactPi -> ExactPi
mappend = ExactPi -> ExactPi -> ExactPi
forall a. Num a => a -> a -> a
(*)