{-
	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@]	Defines the /Ramanujan/ series for /Pi/; <https://planetmath.org/encyclopedia/RamanujansFormulaForPi.html>.
-}

module Factory.Math.Implementations.Pi.Ramanujan.Classic(
-- * Constants
	series
) where

-- import		Control.Arrow((***))
import			Data.Ratio((%))
-- import		Factory.Data.PrimeFactors((>/<), (>^))
-- import qualified	Factory.Data.PrimeFactors				as Data.PrimeFactors
import qualified	Factory.Math.Factorial					as Math.Factorial
import qualified	Factory.Math.Implementations.Factorial			as Math.Implementations.Factorial
import qualified	Factory.Math.Implementations.Pi.Ramanujan.Series	as Math.Implementations.Pi.Ramanujan.Series
import qualified	Factory.Math.Power					as Math.Power
import qualified	Factory.Math.SquareRoot					as Math.SquareRoot

-- | Defines the parameters of the /Ramanujan/ series.
series :: (Math.SquareRoot.Algorithmic squareRootAlgorithm, Math.Factorial.Algorithmic factorialAlgorithm) => Math.Implementations.Pi.Ramanujan.Series.Series squareRootAlgorithm factorialAlgorithm
series :: Series squareRootAlgorithm factorialAlgorithm
series = MkSeries :: forall squareRootAlgorithm factorialAlgorithm.
(factorialAlgorithm -> [Rational])
-> (squareRootAlgorithm -> DecimalDigits -> Rational)
-> ConvergenceRate
-> Series squareRootAlgorithm factorialAlgorithm
Math.Implementations.Pi.Ramanujan.Series.MkSeries {
	terms :: factorialAlgorithm -> [Rational]
Math.Implementations.Pi.Ramanujan.Series.terms			= \factorialAlgorithm
factorialAlgorithm -> let
		toFourthPower :: Integer -> Integer
toFourthPower	= (Integer -> DecimalDigits -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (DecimalDigits
4 :: Int))
	in (Integer -> Integer -> Rational)
-> [Integer] -> [Integer] -> [Rational]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (
{-
		\n power -> let
			product'	= Data.PrimeFactors.product' (recip 2) 10
		in uncurry (%) . (
			(* (1103 + 26390 * n)) . product' *** (* power) . product'
		) $ Math.Implementations.Factorial.primeFactors (4 * n) >/< Math.Implementations.Factorial.primeFactors n >^ 4
-}
		\Integer
n Integer
power -> (
			Integer -> Integer -> Integer
forall i. (Integral i, Show i) => i -> i -> i
Math.Implementations.Factorial.risingFactorial (Integer -> Integer
forall a. Enum a => a -> a
succ Integer
n) (Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer -> Integer
forall n. Num n => n -> n
Math.Power.cube (factorialAlgorithm -> Integer -> Integer
forall algorithm i.
(Algorithmic algorithm, Integral i, Show i) =>
algorithm -> i -> i
Math.Factorial.factorial factorialAlgorithm
factorialAlgorithm Integer
n)
		) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (
			(Integer
1103 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
26390 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
power
		) -- CAVEAT: the order in which these terms are evaluated radically affects performance.
	) [Integer
0 ..] ([Integer] -> [Rational]) -> [Integer] -> [Rational]
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer
toFourthPower Integer
396) Integer
1,
	getSeriesScalingFactor :: squareRootAlgorithm -> DecimalDigits -> Rational
Math.Implementations.Pi.Ramanujan.Series.getSeriesScalingFactor	= \squareRootAlgorithm
squareRootAlgorithm DecimalDigits
decimalDigits -> Rational
9801 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ squareRootAlgorithm -> DecimalDigits -> Integer -> Rational
forall algorithm operand.
(Algorithmic algorithm, Real operand, Show operand) =>
algorithm -> DecimalDigits -> operand -> Rational
Math.SquareRoot.squareRoot squareRootAlgorithm
squareRootAlgorithm DecimalDigits
decimalDigits (Integer
8 :: Integer),
	convergenceRate :: ConvergenceRate
Math.Implementations.Pi.Ramanujan.Series.convergenceRate	= ConvergenceRate
10 ConvergenceRate -> ConvergenceRate -> ConvergenceRate
forall a. Floating a => a -> a -> a
** ConvergenceRate -> ConvergenceRate
forall n. Num n => n -> n
negate ConvergenceRate
7.9	-- Empirical.
}