{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ParallelListComp    #-}

{-# OPTIONS_HADDOCK show-extensions #-}

{-|
Module      : Data.ExactPi
Description : Exact rational multiples of powers of pi
License     : MIT
Maintainer  : douglas.mcclean@gmail.com
Stability   : experimental

This type is sufficient to exactly express the closure of Q ∪ {π} under multiplication and division.
As a result it is useful for representing conversion factors
between physical units. Approximate values are included both to close the remainder
of the arithmetic operations in the `Num` typeclass and to encode conversion
factors defined experimentally.
-}
module Data.ExactPi
(
  ExactPi(..),
  approximateValue,
  isZero,
  isExact,
  isExactZero,
  isExactOne,
  areExactlyEqual,
  isExactInteger,
  toExactInteger,
  isExactRational,
  toExactRational,
  rationalApproximations,
  -- * Utils
  getRationalLimit
)
where

import Data.Monoid
import Data.Ratio ((%), numerator, denominator)
import Data.Semigroup
import Prelude

-- | Represents an exact or approximate real value.
-- The exactly representable values are rational multiples of an integer power of pi.
data ExactPi = Exact Integer Rational -- ^ @'Exact' z q@ = q * pi^z. Note that this means there are many representations of zero.
             | Approximate (forall a.Floating a => a) -- ^ An approximate value. This representation was chosen because it allows conversion to floating types using their native definition of 'pi'.

-- | Approximates an exact or approximate value, converting it to a `Floating` type.
-- This uses the value of `pi` supplied by the destination type, to provide the appropriate
-- precision.
approximateValue :: Floating a => ExactPi -> a
approximateValue :: forall a. Floating a => ExactPi -> a
approximateValue (Exact Integer
z Ratio Integer
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
* (Ratio Integer -> a
forall a. Fractional a => Ratio Integer -> a
fromRational Ratio Integer
q)
approximateValue (Approximate forall a. Floating a => a
x) = a
forall a. Floating a => a
x

-- | Identifies whether an 'ExactPi' is an exact or approximate representation of zero.
isZero :: ExactPi -> Bool
isZero :: ExactPi -> Bool
isZero (Exact Integer
_ Ratio Integer
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

-- | Identifies whether an 'ExactPi' is an exact value.
isExact :: ExactPi -> Bool
isExact :: ExactPi -> Bool
isExact (Exact Integer
_ Ratio Integer
_) = Bool
True
isExact ExactPi
_           = Bool
False

-- | Identifies whether an 'ExactPi' is an exact representation of zero.
isExactZero :: ExactPi -> Bool
isExactZero :: ExactPi -> Bool
isExactZero (Exact Integer
_ Ratio Integer
0) = Bool
True
isExactZero ExactPi
_ = Bool
False

-- | Identifies whether an 'ExactPi' is an exact representation of one.
isExactOne :: ExactPi -> Bool
isExactOne :: ExactPi -> Bool
isExactOne (Exact Integer
0 Ratio Integer
1) = Bool
True
isExactOne ExactPi
_ = Bool
False

-- | Identifies whether two 'ExactPi' values are exactly equal.
areExactlyEqual :: ExactPi -> ExactPi -> Bool
areExactlyEqual :: ExactPi -> ExactPi -> Bool
areExactlyEqual (Exact Integer
z1 Ratio Integer
q1) (Exact Integer
z2 Ratio Integer
q2) = (Integer
z1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
z2 Bool -> Bool -> Bool
&& Ratio Integer
q1 Ratio Integer -> Ratio Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Integer
q2) Bool -> Bool -> Bool
|| (Ratio Integer
q1 Ratio Integer -> Ratio Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Integer
0 Bool -> Bool -> Bool
&& Ratio Integer
q2 Ratio Integer -> Ratio Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Integer
0)
areExactlyEqual ExactPi
_ ExactPi
_ = Bool
False

-- | Identifies whether an 'ExactPi' is an exact representation of an integer.
isExactInteger :: ExactPi -> Bool
isExactInteger :: ExactPi -> Bool
isExactInteger (Exact Integer
0 Ratio Integer
q) | Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
q Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Bool
True
isExactInteger ExactPi
_                                = Bool
False

-- | Converts an 'ExactPi' to an exact 'Integer' or 'Nothing'.
toExactInteger :: ExactPi -> Maybe Integer
toExactInteger :: ExactPi -> Maybe Integer
toExactInteger (Exact Integer
0 Ratio Integer
q) | Ratio Integer -> Integer
forall a. Ratio a -> a
denominator Ratio Integer
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
$ Ratio Integer -> Integer
forall a. Ratio a -> a
numerator Ratio Integer
q
toExactInteger ExactPi
_                                = Maybe Integer
forall a. Maybe a
Nothing

-- | Identifies whether an 'ExactPi' is an exact representation of a rational.
isExactRational :: ExactPi -> Bool
isExactRational :: ExactPi -> Bool
isExactRational (Exact Integer
0 Ratio Integer
_) = Bool
True
isExactRational ExactPi
_           = Bool
False

-- | Converts an 'ExactPi' to an exact 'Rational' or 'Nothing'.
toExactRational :: ExactPi -> Maybe Rational
toExactRational :: ExactPi -> Maybe (Ratio Integer)
toExactRational (Exact Integer
0 Ratio Integer
q) = Ratio Integer -> Maybe (Ratio Integer)
forall a. a -> Maybe a
Just Ratio Integer
q
toExactRational ExactPi
_           = Maybe (Ratio Integer)
forall a. Maybe a
Nothing

-- | Converts an 'ExactPi' to a list of increasingly accurate rational approximations. Note
-- that 'Approximate' values are converted using the 'Real' instance for 'Double' into a
-- singleton list. Note that exact rationals are also converted into a singleton list.
--
-- Implementation is based on Chudnovsky's algorithm.
rationalApproximations :: ExactPi -> [Rational]
rationalApproximations :: ExactPi -> [Ratio Integer]
rationalApproximations (Approximate forall a. Floating a => a
x) = [Double -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational (Double
forall a. Floating a => a
x :: Double)]
rationalApproximations (Exact Integer
_ Ratio Integer
0)     = [Ratio Integer
0]
rationalApproximations (Exact Integer
0 Ratio Integer
q)     = [Ratio Integer
q]
rationalApproximations (Exact Integer
z Ratio Integer
q)
  | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
z    = [Ratio Integer
q Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
10005Ratio Integer -> Integer -> Ratio Integer
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
k Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
cRatio Integer -> Integer -> Ratio Integer
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
z     | Ratio Integer
c <- [Ratio Integer]
chudnovsky]
  | Bool
otherwise = [Ratio Integer
q Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
10005Ratio Integer -> Integer -> Ratio Integer
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
k Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
cRatio Integer -> Integer -> Ratio Integer
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
z Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
r | Ratio Integer
c <- [Ratio Integer]
chudnovsky | Ratio Integer
r <- [Ratio Integer]
rootApproximation]
  where k :: Integer
k = Integer
z Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2

chudnovsky :: [Rational]
chudnovsky :: [Ratio Integer]
chudnovsky = [Ratio Integer
426880 Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a -> a
/ Ratio Integer
s | Ratio Integer
s <- [Ratio Integer]
partials]
  where lk :: [Ratio Integer]
lk = (Ratio Integer -> Ratio Integer)
-> Ratio Integer -> [Ratio Integer]
forall a. (a -> a) -> a -> [a]
iterate (Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
+Ratio Integer
545140134) Ratio Integer
13591409
        xk :: [Ratio Integer]
xk = (Ratio Integer -> Ratio Integer)
-> Ratio Integer -> [Ratio Integer]
forall a. (a -> a) -> a -> [a]
iterate (Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
*(-Ratio Integer
262537412640768000)) Ratio Integer
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 :: [Ratio Integer]
mk = Ratio Integer
1Ratio Integer -> [Ratio Integer] -> [Ratio Integer]
forall a. a -> [a] -> [a]
: [Ratio Integer
m Ratio Integer -> Ratio Integer -> Ratio Integer
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 -> Ratio Integer
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)) | Ratio Integer
m <- [Ratio Integer]
mk | Integer
k <- [Integer]
kk | Integer
n <- [Integer
0..]]
        values :: [Ratio Integer]
values = [Ratio Integer
m Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
l Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a -> a
/ Ratio Integer
x | Ratio Integer
m <- [Ratio Integer]
mk | Ratio Integer
l <- [Ratio Integer]
lk | Ratio Integer
x <- [Ratio Integer]
xk]
        partials :: [Ratio Integer]
partials = (Ratio Integer -> Ratio Integer -> Ratio Integer)
-> [Ratio Integer] -> [Ratio Integer]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
(+) [Ratio Integer]
values

-- | Given an infinite converging sequence of rationals, find their limit.
-- Takes a comparison function to determine when convergence is close enough.
--
-- >>> getRationalLimit (==) (rationalApproximations (Exact 1 1)) :: Double
-- 3.141592653589793
getRationalLimit :: Fractional a => (a -> a -> Bool) -> [Rational] -> a
getRationalLimit :: forall a. Fractional a => (a -> a -> Bool) -> [Ratio Integer] -> a
getRationalLimit a -> a -> Bool
cmp = [a] -> a
go ([a] -> a) -> ([Ratio Integer] -> [a]) -> [Ratio Integer] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ratio Integer -> a) -> [Ratio Integer] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Ratio Integer -> a
forall a. Fractional a => Ratio Integer -> 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"

-- | A sequence of convergents approximating @sqrt 10005@, intended to be zipped
-- with 'chudnovsky' in 'rationalApproximations'. Carefully chosen so that
-- the denominator does not increase too rapidly but approximations are still
-- appropriately precise.
--
-- Chudnovsky's series provides no more than 15 digits
-- per iteration, so the root approximation should not
-- have a more rapid rate of convergence.
rootApproximation :: [Rational]
rootApproximation :: [Ratio Integer]
rootApproximation = ([Ratio Integer] -> Ratio Integer)
-> [[Ratio Integer]] -> [Ratio Integer]
forall a b. (a -> b) -> [a] -> [b]
map [Ratio Integer] -> Ratio Integer
forall a. [a] -> a
head ([[Ratio Integer]] -> [Ratio Integer])
-> ([Ratio Integer] -> [[Ratio Integer]])
-> [Ratio Integer]
-> [Ratio Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Ratio Integer] -> [Ratio Integer])
-> [Ratio Integer] -> [[Ratio Integer]]
forall a. (a -> a) -> a -> [a]
iterate (Int -> [Ratio Integer] -> [Ratio Integer]
forall a. Int -> [a] -> [a]
drop Int
4) ([Ratio Integer] -> [Ratio Integer])
-> [Ratio Integer] -> [Ratio Integer]
forall a b. (a -> b) -> a -> b
$ Integer
-> Integer -> Integer -> Integer -> Integer -> [Ratio Integer]
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 Ratio Integer
q) | Integer
z Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = [Char]
"Exactly " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Ratio Integer -> [Char]
forall a. Show a => a -> [Char]
show Ratio Integer
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]
++ Ratio Integer -> [Char]
forall a. Show a => a -> [Char]
show Ratio Integer
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]
++ Ratio Integer -> [Char]
forall a. Show a => a -> [Char]
show Ratio Integer
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 -> Ratio Integer -> ExactPi
Exact Integer
0 (Integer -> Ratio Integer
forall a. Num a => Integer -> a
fromInteger Integer
n)
  (Exact Integer
z1 Ratio Integer
q1) * :: ExactPi -> ExactPi -> ExactPi
* (Exact Integer
z2 Ratio Integer
q2) = Integer -> Ratio Integer -> ExactPi
Exact (Integer
z1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
z2) (Ratio Integer
q1 Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
q2)
  (Exact Integer
_ Ratio Integer
0) * ExactPi
_ = ExactPi
0
  ExactPi
_ * (Exact Integer
_ Ratio Integer
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 Ratio Integer
q1) + :: ExactPi -> ExactPi -> ExactPi
+ (Exact Integer
z2 Ratio Integer
q2) | Integer
z1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
z2 = Integer -> Ratio Integer -> ExactPi
Exact Integer
z1 (Ratio Integer
q1 Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
+ Ratio Integer
q2) -- by distributive property
  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 Ratio Integer
q) = Integer -> Ratio Integer -> ExactPi
Exact Integer
z (Ratio Integer -> Ratio Integer
forall a. Num a => a -> a
abs Ratio Integer
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
_ Ratio Integer
q) = Integer -> Ratio Integer -> ExactPi
Exact Integer
0 (Ratio Integer -> Ratio Integer
forall a. Num a => a -> a
signum Ratio Integer
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 -- we leave this tagged as approximate because we don't know "how" approximate the input was. a case could be made for exact answers here.
  negate :: ExactPi -> ExactPi
negate ExactPi
x = (Integer -> Ratio Integer -> ExactPi
Exact Integer
0 (-Ratio Integer
1)) ExactPi -> ExactPi -> ExactPi
forall a. Num a => a -> a -> a
* ExactPi
x

instance Fractional ExactPi where
  fromRational :: Ratio Integer -> ExactPi
fromRational = Integer -> Ratio Integer -> ExactPi
Exact Integer
0
  recip :: ExactPi -> ExactPi
recip (Exact Integer
z Ratio Integer
q) = Integer -> Ratio Integer -> ExactPi
Exact (Integer -> Integer
forall a. Num a => a -> a
negate Integer
z) (Ratio Integer -> Ratio Integer
forall a. Fractional a => a -> a
recip Ratio Integer
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 -> Ratio Integer -> ExactPi
Exact Integer
1 Ratio Integer
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 Ratio Integer
1) = ExactPi
0
  log ExactPi
x = (forall a. Floating a => a -> a) -> ExactPi -> ExactPi
approx1 forall a. Floating a => a -> a
log ExactPi
x
  -- It would be possible to give tighter bounds to the trig functions, preserving exactness for arguments that have an exactly representable result.
  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))

-- | The multiplicative semigroup over 'Rational's augmented with multiples of 'pi'.
instance Semigroup ExactPi where
  <> :: ExactPi -> ExactPi -> ExactPi
(<>) = ExactPi -> ExactPi -> ExactPi
forall a. Monoid a => a -> a -> a
mappend

-- | The multiplicative monoid over 'Rational's augmented with multiples of 'pi'.
instance Monoid ExactPi where
  mempty :: ExactPi
mempty = ExactPi
1
  mappend :: ExactPi -> ExactPi -> ExactPi
mappend = ExactPi -> ExactPi -> ExactPi
forall a. Num a => a -> a -> a
(*)