{-
	Copyright (C) 2011 Dr. Alistair Ward

	This program is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	This program is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with this program.  If not, see <https://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Implements a /Bailey-Borwein-Plouffe/ formula; <https://mathworld.wolfram.com/PiFormulas.html>

	* Surprisingly, because of the huge size of the 'Rational' quantities,
	it is a /single/ call to @Factory.Math.Summation.sum'@, rather than the calculation of the many terms in the series, which is the performance-bottleneck.
-}

module Factory.Math.Implementations.Pi.BBP.Implementation(
-- * Functions
	openR
) where

import			Data.Ratio((%))
import qualified	Factory.Math.Implementations.Pi.BBP.Series	as Math.Implementations.Pi.BBP.Series
import qualified	Factory.Math.Precision				as Math.Precision
import qualified	Factory.Math.Summation				as Math.Summation

-- | Returns /Pi/, accurate to the specified number of decimal digits.
openR
	:: Math.Implementations.Pi.BBP.Series.Series	-- ^ This /Pi/-algorithm is parameterised by the type of other algorithms to use.
	-> Math.Precision.DecimalDigits			-- ^ The number of decimal digits required.
	-> Rational
openR :: Series -> DecimalDigits -> Rational
openR Math.Implementations.Pi.BBP.Series.MkSeries {
	numerators :: Series -> [Integer]
Math.Implementations.Pi.BBP.Series.numerators		= [Integer]
numerators,
	getDenominators :: Series -> DecimalDigits -> [Integer]
Math.Implementations.Pi.BBP.Series.getDenominators	= DecimalDigits -> [Integer]
getDenominators,
	seriesScalingFactor :: Series -> Rational
Math.Implementations.Pi.BBP.Series.seriesScalingFactor	= Rational
seriesScalingFactor,
	base :: Series -> Integer
Math.Implementations.Pi.BBP.Series.base			= Integer
base
} DecimalDigits
decimalDigits		= (Rational
seriesScalingFactor Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*) (Rational -> Rational)
-> ([Rational] -> Rational) -> [Rational] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecimalDigits -> [Rational] -> Rational
forall n. (Num n, NFData n) => DecimalDigits -> [n] -> n
Math.Summation.sum' DecimalDigits
8 ([Rational] -> Rational)
-> ([Rational] -> [Rational]) -> [Rational] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecimalDigits -> [Rational] -> [Rational]
forall a. DecimalDigits -> [a] -> [a]
take (
	ConvergenceRate -> DecimalDigits -> DecimalDigits
forall i. Integral i => ConvergenceRate -> DecimalDigits -> i
Math.Precision.getTermsRequired (
		ConvergenceRate -> ConvergenceRate
forall a. Fractional a => a -> a
recip (ConvergenceRate -> ConvergenceRate)
-> (Integer -> ConvergenceRate) -> Integer -> ConvergenceRate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConvergenceRate
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> ConvergenceRate) -> Integer -> ConvergenceRate
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs {-potentially negative-} Integer
base	-- The convergence-rate.
	) DecimalDigits
decimalDigits
 ) ([Rational] -> [Rational])
-> ([Rational] -> [Rational]) -> [Rational] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational)
-> [Rational] -> [Rational] -> [Rational]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*) (
	(Rational -> Rational) -> Rational -> [Rational]
forall a. (a -> a) -> a -> [a]
iterate (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
base) Rational
1	-- Generate the scaling-ratio, between successive terms.
 ) ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$ (DecimalDigits -> Rational) -> [DecimalDigits] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (
	[Rational] -> Rational
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Rational] -> Rational)
-> (DecimalDigits -> [Rational]) -> DecimalDigits -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Rational)
-> [Integer] -> [Integer] -> [Rational]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
(%) [Integer]
numerators ([Integer] -> [Rational])
-> (DecimalDigits -> [Integer]) -> DecimalDigits -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecimalDigits -> [Integer]
getDenominators
 ) [DecimalDigits
0 ..]