{-# LANGUAGE NoImplicitPrelude #-}{- |
Copyright : (c) Henning Thielemann 2006
License : GPL
Maintainer : numericprelude@henning-thielemann.de
Stability : provisional
Exact Real Arithmetic - Computable reals.
Inspired by ''The most unreliable technique for computing pi.''
See also <http://www.haskell.org/haskellwiki/Exact_real_arithmetic> .
-}moduleNumber.PositionalwhereimportqualifiedMathObj.LaurentPolynomialasLPolyimportqualifiedMathObj.PolynomialasPolyimportqualifiedAlgebra.IntegralDomainasIntegralimportqualifiedAlgebra.RingasRingimportqualifiedAlgebra.AdditiveasAdditiveimportqualifiedAlgebra.ToIntegerasToIntegerimportqualifiedPreludeasP98importqualifiedPreludeBaseasPimportqualifiedNumericPreludeasNPimportPreludeBaseimportNumericPreludehiding(sqrt,tan,one,zero,)importqualifiedData.ListasListimportData.Char(intToDigit)importqualifiedData.List.MatchasMatchimportData.Function.HT(powerAssociative,nest,)importData.Tuple.HT(swap,)importData.Maybe.HT(toMaybe,)importData.Bool.HT(select,if',)importNumericPrelude.List(mapLast,)importData.List.HT(sliceVertical,mapAdjacent,padLeft,padRight,){-
bugs:
defltBase = 10
defltExp = 4
(sqrt 0.5) -- wrong result, probably due to undetected overflows
-}{- * types -}typeT=(Exponent,Mantissa)typeFixedPoint=(Integer,Mantissa)typeMantissa=[Digit]typeDigit=InttypeExponent=InttypeBasis=Int{- * basic helpers -}moveToZero::Basis->Digit->(Digit,Digit)moveToZerobn=letb2=NP.divb2(q,r)=divMod(n+b2)bin(q,r-b2)checkPosDigit::Basis->Digit->DigitcheckPosDigitbd=ifd>=0&&d<bthendelseerror("digit "++showd++" out of range [0,"++showb++")")checkDigit::Basis->Digit->DigitcheckDigitbd=ifabsd<bthendelseerror("digit "++showd++" out of range ("++show(-b)++","++showb++")"){- |
Converts all digits to non-negative digits,
that is the usual positional representation.
However the conversion will fail
when the remaining digits are all zero.
(This cannot be improved!)
-}nonNegative::Basis->T->TnonNegativebx=let(xe,xm)=compressbxin(xe,nonNegativeMantbxm){- |
Requires, that no digit is @(basis-1)@ or @(1-basis)@.
The leading digit might be negative and might be @-basis@ or @basis@.
-}nonNegativeMant::Basis->Mantissa->MantissanonNegativeMantb=letrecurse(x0:x1:xs)=select(replaceZeroChainx0(x1:xs))[(x1>=1,x0:recurse(x1:xs)),(x1<=-1,(x0-1):recurse((x1+b):xs))]recursexs=xsreplaceZeroChainxxs=let(xZeros,xRem)=span(0==)xsincasexRemof[]->(x:xs)-- keep trailing zeros, because they show precision in 'show' functions(y:ys)->ify>=0-- equivalent to y>0thenx:Match.replicatexZeros0++recursexRemelse(x-1):Match.replicatexZeros(b-1)++recurse((y+b):ys)inrecurse{- |
May prepend a digit.
-}compress::Basis->T->Tcompress_x@(_,[])=xcompressb(xe,xm)=let(hi:his,los)=unzip(map(moveToZerob)xm)inprependDigithi(xe,Poly.addhislos){- |
Compress first digit.
May prepend a digit.
-}compressFirst::Basis->T->TcompressFirst_x@(_,[])=xcompressFirstb(xe,x:xs)=let(hi,lo)=moveToZerobxinprependDigithi(xe,lo:xs){- |
Does not prepend a digit.
-}compressMant::Basis->Mantissa->MantissacompressMant_[]=[]compressMantb(x:xs)=let(his,los)=unzip(map(moveToZerob)xs)inPoly.addhis(x:los){- |
Compress second digit.
Sometimes this is enough to keep the digits in the admissible range.
Does not prepend a digit.
-}compressSecondMant::Basis->Mantissa->MantissacompressSecondMantb(x0:x1:xs)=let(hi,lo)=moveToZerobx1inx0+hi:lo:xscompressSecondMant_xm=xmprependDigit::Basis->T->TprependDigit0x=xprependDigitx(xe,xs)=(xe+1,x:xs){- |
Eliminate leading zero digits.
This will fail for zero.
-}trim::T->Ttrim(xe,xm)=let(xZero,xNonZero)=span(0==)xmin(xe-lengthxZero,xNonZero){- |
Trim until a minimum exponent is reached.
Safe for zeros.
-}trimUntil::Exponent->T->TtrimUntile=until(\(xe,xm)->xe<=e||not(nullxm||headxm==0))trimOncetrimOnce::T->TtrimOnce(xe,[])=(xe-1,[])trimOnce(xe,0:xm)=(xe-1,xm)trimOncex=x{- |
Accept a high leading digit for the sake of a reduced exponent.
This eliminates one leading digit.
Like 'pumpFirst' but with exponent management.
-}decreaseExp::Basis->T->TdecreaseExpb(xe,xm)=(xe-1,pumpFirstbxm){- |
Merge leading and second digit.
This is somehow an inverse of 'compressMant'.
-}pumpFirst::Basis->Mantissa->MantissapumpFirstbxm=casexmof(x0:x1:xs)->x0*b+x1:xs(x0:[])->x0*b:[][]->[]decreaseExpFP::Basis->(Exponent,FixedPoint)->(Exponent,FixedPoint)decreaseExpFPb(xe,xm)=(xe-1,pumpFirstFPbxm)pumpFirstFP::Basis->FixedPoint->FixedPointpumpFirstFPb(x,xm)=letxb=x*fromIntegralbincasexmof(x0:xs)->(xb+fromIntegralx0,xs)[]->(xb,[]){- |
Make sure that a number with absolute value less than 1
has a (small) negative exponent.
Also works with zero because it chooses an heuristic exponent for stopping.
-}negativeExp::Basis->T->TnegativeExpbx=lettx=trimUntil(-10)xiniffsttx>=0thendecreaseExpbtxelsetx{- * conversions -}{- ** integer -}fromBaseCardinal::Basis->Integer->TfromBaseCardinalbn=letmant=mantissaFromCardbnin(lengthmant-1,mant)fromBaseInteger::Basis->Integer->TfromBaseIntegerbn=ifn<0thennegb(fromBaseCardinalb(negaten))elsefromBaseCardinalbnmantissaToNum::Ring.Ca=>Basis->Mantissa->amantissaToNumbInt=letb=fromIntegralbIntinfoldl(\xd->x*b+fromIntegrald)0mantissaFromCard::(ToInteger.Ca)=>Basis->a->MantissamantissaFromCardbIntn=letb=NP.fromIntegralbIntinreverse(mapNP.fromIntegral(Integral.decomposeVarPositional(repeatb)n))mantissaFromInt::(ToInteger.Ca)=>Basis->a->MantissamantissaFromIntbn=ifn<0thennegate(mantissaFromCardb(negaten))elsemantissaFromCardbnmantissaFromFixedInt::Basis->Exponent->Integer->MantissamantissaFromFixedIntbInten=letb=NP.fromIntegralbIntinmapNP.fromIntegral(uncurry(:)(List.mapAccumR(\x()->divModxb)n(replicate(prede)()))){- ** rational -}fromBaseRational::Basis->Rational->TfromBaseRationalbIntx=letb=NP.fromIntegralbIntxDen=denominatorx(xInt,xNum)=divMod(numeratorx)xDen(xe,xm)=fromBaseIntegerbIntxIntxFrac=List.unfoldr(\num->toMaybe(num/=0)(divMod(num*b)xDen))xNumin(xe,xm++mapNP.fromIntegerxFrac){- ** fixed point -}{- |
Split into integer and fractional part.
-}toFixedPoint::Basis->T->FixedPointtoFixedPointb(xe,xm)=ifxe>=0thenlet(x0,x1)=splitAtPadZero(xe+1)xmin(mantissaToNumbx0,x1)else(0,replicate(-succxe)0++xm)fromFixedPoint::Basis->FixedPoint->TfromFixedPointb(xInt,xFrac)=let(xe,xm)=fromBaseIntegerbxIntin(xe,xm++xFrac){- ** floating point -}toDouble::Basis->T->DoubletoDoubleb(xe,xm)=lettxm=take(mantLengthDoubleb)xmbf=fromIntegralbbr=recipbfinfieldPowerxebf*foldr(\xiy->fromIntegralxi+y*br)0txm{- |
cf. 'Numeric.floatToDigits'
-}fromDouble::Basis->Double->TfromDoublebx=let(n,frac)=splitFractionx(mant,e)=P98.decodeFloatfracfracR=alignMantb(-1)(fromBaseRationalb(mant%ringPower(-e)2))infromFixedPointb(n,fracR){- |
Only return as much digits as are contained in Double.
This will speedup further computations.
-}fromDoubleApprox::Basis->Double->TfromDoubleApproxbx=let(xe,xm)=fromDoublebxin(xe,take(mantLengthDoubleb)xm)fromDoubleRough::Basis->Double->TfromDoubleRoughbx=let(xe,xm)=fromDoublebxin(xe,take2xm)mantLengthDouble::Basis->ExponentmantLengthDoubleb=letfi=fromIntegral::Int->Doublex=undefined::Doubleinceiling(logBase(fib)(fromInteger(P98.floatRadixx))*fi(P98.floatDigitsx))liftDoubleApprox::Basis->(Double->Double)->T->TliftDoubleApproxbf=fromDoubleApproxb.f.toDoublebliftDoubleRough::Basis->(Double->Double)->T->TliftDoubleRoughbf=fromDoubleRoughb.f.toDoubleb{- ** text -}{- |
Show a number with respect to basis @10^e@.
-}showDec::Exponent->T->StringshowDec=showBasis10showHex::Exponent->T->StringshowHex=showBasis16showBin::Exponent->T->StringshowBin=showBasis2showBasis::Basis->Exponent->T->StringshowBasisbexBig=letx=rootBasisbexBig(sign,absX)=casecmpbx(fstx,[])ofLT->("-",negbx)_->("",x)(int,frac)=toFixedPointb(nonNegativebabsX)checkedFrac=map(checkPosDigitb)fracintStr=ifb==10thenshowintelsemapintToDigit(mantissaFromIntbint)insign++intStr++'.':mapintToDigitcheckedFrac{- ** basis -}{- |
Convert from a @b@ basis representation to a @b^e@ basis.
Works well with every exponent.
-}powerBasis::Basis->Exponent->T->TpowerBasisbe(xe,xm)=let(ye,r)=divModxee(y0,y1)=splitAtPadZero(r+1)xmy1pad=mapLast(padRight0e)(sliceVerticaley1)in(ye,map(mantissaToNumb)(y0:y1pad)){- |
Convert from a @b^e@ basis representation to a @b@ basis.
Works well with every exponent.
-}rootBasis::Basis->Exponent->T->TrootBasisbe(xe,xm)=letsplitDigitd=padLeft0e(mantissaFromIntbd)innest(e-1)trimOnce((xe+1)*e-1,concatMapsplitDigit(map(checkDigit(ringPowereb))xm)){- |
Convert between arbitrary bases.
This conversion is expensive (quadratic time).
-}fromBasis::Basis->Basis->T->TfromBasisbDstbSrcx=let(int,frac)=toFixedPointbSrcxinfromFixedPointbDst(int,fromBasisMantbDstbSrcfrac)fromBasisMant::Basis->Basis->Mantissa->MantissafromBasisMant__[]=[]fromBasisMantbDstbSrcxm=let{- We use a counter that alerts us,
when the digits are grown too much by Poly.scale.
Then it is time to do some carry/compression.
'inc' is essentially the fractional number digits
needed to represent the destination base in the source base.
It is multiplied by 'unit' in order to allow integer computation. -}inc=ceiling(logBase(fromIntegralbSrc)(fromIntegralbDst)*unit*1.1::Double)-- Without the correction factor, invalid digits are emitted - why?unit::Ring.Ca=>aunit=10000{-
This would create finite representations
in some cases (input is finite, and the result is finite)
but will cause infinite loop otherwise.
dropWhileRev (0==) . compressMant bDst
-}cmpr(mag,xs)=(mag-unit,compressMantbSrcxs)scl(_,[])=Nothingscl(mag,xs)=let(newMag,y:ys)=until((<unit).fst)cmpr(mag+inc,Poly.scalebDstxs)(d,y0)=moveToZerobSrcyinJust(d,(newMag,y0:ys))inList.unfoldrscl(0::Int,xm){- * comparison -}{- |
The basis must be at least ***.
Note: Equality cannot be asserted in finite time on infinite precise numbers.
If you want to assert, that a number is below a certain threshold,
you should not call this routine directly,
because it will fail on equality.
Better round the numbers before comparison.
-}cmp::Basis->T->T->Orderingcmpbxy=let(_,dm)=subbxy{- Only differences above 2 allow a safe decision,
because 1(-9)(-9)(-9)(-9)... and (-1)9999...
represent the same number, namely zero. -}recurse[]=EQrecurse(d:[])=compared0recurse(d0:d1:ds)=select(recurse(d0*b+d1:ds))[(d0<-2,LT),(d0>2,GT)]inrecursedm{-
Compare two numbers approximately.
This circumvents the infinite loop if both numbers are equal.
If @lessApprox bnd b x y@
then @x@ is definitely smaller than @y@.
The converse is not true.
You should use this one instead of 'cmp' for checking for bounds.
-}lessApprox::Basis->Exponent->T->T->BoollessApproxbbndxy=lettx=truncbndxty=truncbndyinLT==cmpb(liftLaurent2LPoly.add(bnd,[2])tx)tytrunc::Exponent->T->Ttruncbnd(xe,xm)=ifbnd>xethen(bnd,[])else(xe,take(1+xe-bnd)xm)equalApprox::Basis->Exponent->T->T->BoolequalApproxbbndxy=fst(trimUntilbnd(subbxy))==bndalign::Basis->Exponent->T->Talignbyex=(ye,alignMantbyex){- |
Get the mantissa in such a form
that it fits an expected exponent.
@x@ and @(e, alignMant b e x)@ represent the same number.
-}alignMant::Basis->Exponent->T->MantissaalignMantbe(xe,xm)=ife>=xethenreplicate(e-xe)0++xmelselet(xm0,xm1)=splitAtPadZero(xe-e+1)xminmantissaToNumbxm0:xm1absolute::T->Tabsolute(xe,xm)=(xe,absMantxm)absMant::Mantissa->MantissaabsMantxa@(x:xs)=casecomparex0ofEQ->x:absMantxsLT->Poly.negatexaGT->xaabsMant[]=[]{- * arithmetic -}fromLaurent::LPoly.TInt->TfromLaurent(LPoly.Consnxexm)=(NP.negatenxe,xm)toLaurent::T->LPoly.TInttoLaurent(xe,xm)=LPoly.Cons(NP.negatexe)xmliftLaurent2::(LPoly.TInt->LPoly.TInt->LPoly.TInt)->(T->T->T)liftLaurent2fxy=fromLaurent(f(toLaurentx)(toLaurenty))liftLaurentMany::([LPoly.TInt]->LPoly.TInt)->([T]->T)liftLaurentManyf=fromLaurent.f.maptoLaurent{- |
Add two numbers but do not eliminate leading zeros.
-}add::Basis->T->T->Taddbxy=compressb(liftLaurent2LPoly.addxy)sub::Basis->T->T->Tsubbxy=compressb(liftLaurent2LPoly.subxy)neg::Basis->T->Tneg_(xe,xm)=(xe,Poly.negatexm){- |
Add at most @basis@ summands.
More summands will violate the allowed digit range.
-}addSome::Basis->[T]->TaddSomeb=compressb.liftLaurentManysum{- |
Add many numbers efficiently by computing sums of sub lists
with only little carry propagation.
-}addMany::Basis->[T]->TaddMany_[]=zeroaddManybys=letrecursexs=casemap(addSomeb)(sliceVerticalbxs)of[s]->ssums->recursesumsinrecurseystypeSeries=[(Exponent,T)]{- |
Add an infinite number of numbers.
You must provide a list of estimate of the current remainders.
The estimates must be given as exponents of the remainder.
If such an exponent is too small, the summation will be aborted.
If exponents are too big, computation will become inefficient.
-}series::Basis->Series->Tseries_[]=error"empty series: don't know a good exponent"-- series _ [] = (0,[]) -- unfortunate choice of exponentseriesbsummands={- Some pre-processing that asserts decreasing exponents.
Increasing coefficients can appear legally
due to non-unique number representation. -}let(es,xs)=unzipsummandssafeSeries=zip(scanl1mines)xsinseriesPlainbsafeSeriesseriesPlain::Basis->Series->TseriesPlain_[]=error"empty series: don't know a good exponent"seriesPlainbsummands=let(es,m:ms)=unzip(map(uncurry(alignb))summands)eDifs=mapAdjacent(-)eseDifLists=sliceVertical(predb)eDifsmLists=sliceVertical(predb)msaccumsumM(eDifList,mList)=letsubM=LPoly.addShiftedManyeDifList(sumM:mList)-- lazy unary sumlen=concatMap(flipreplicate())eDifList(high,low)=splitAtMatchPadZerolensubM{-
'compressMant' looks unsafe
when the residue doesn't decrease for many summands.
Then there is a leading digit of a chunk
which is not compressed for long time.
However, if the residue is estimated correctly
there can be no overflow.
-}in(compressMantblow,high)(trailingDigits,chunks)=List.mapAccumLaccumm(zipeDifListsmLists)incompressb(heades,concatchunks++trailingDigits){-
An alternative series implementation
could reduce carries by do the following cycle
(split, add sub-lists).
This would reduce carries to the minimum
but we must work hard in order to find out lazily
how many digits can be emitted.
-}{- |
Like 'splitAt',
but it pads with zeros if the list is too short.
This way it preserves
@ length (fst (splitAtPadZero n xs)) == n @
-}splitAtPadZero::Int->Mantissa->(Mantissa,Mantissa)splitAtPadZeron[]=(replicaten0,[])splitAtPadZero0xs=([],xs)splitAtPadZeron(x:xs)=let(ys,zs)=splitAtPadZero(n-1)xsin(x:ys,zs)-- must get a case for negative indexsplitAtMatchPadZero::[()]->Mantissa->(Mantissa,Mantissa)splitAtMatchPadZeron[]=(Match.replicaten0,[])splitAtMatchPadZero[]xs=([],xs)splitAtMatchPadZeron(x:xs)=let(ys,zs)=splitAtMatchPadZero(tailn)xsin(x:ys,zs){- |
help showing series summands
-}truncSeriesSummands::Series->SeriestruncSeriesSummands=map(\(e,x)->(e,trunc(-20)x))scale::Basis->Digit->T->Tscalebyx=compressb(scaleSimpleyx){-
scaleSimple :: ToInteger.C a => a -> T -> T
scaleSimple y (xe, xm) = (xe, Poly.scale (fromIntegral y) xm)
-}scaleSimple::Basis->T->TscaleSimpley(xe,xm)=(xe,Poly.scaleyxm)scaleMant::Basis->Digit->Mantissa->MantissascaleMantbyxm=compressMantb(Poly.scaleyxm)mulSeries::Basis->T->T->SeriesmulSeries_(xe,[])(ye,_)=[(xe+ye,zero)]mulSeriesb(xe,xm)(ye,ym)=letzes=iteratepred(xe+ye+1)zs=zipWith(\xde->scalebxd(e,ym))xm(tailzes)inzipzeszs{- |
For obtaining n result digits it is mathematically sufficient
to know the first (n+1) digits of the operands.
However this implementation needs (n+2) digits,
because of calls to 'compress' in both 'scale' and 'series'.
We should fix that.
-}mul::Basis->T->T->Tmulbxy=trimOnce(seriesPlainb(mulSeriesbxy)){- |
Undefined if the divisor is zero - of course.
Because it is impossible to assert that a real is zero,
the routine will not throw an error in general.
ToDo: Rigorously derive the minimal required magnitude of the leading divisor digit.
-}divide::Basis->T->T->Tdivideb(xe,xm)(ye',ym')=let(ye,ym)=until((>=b).abs.head.snd)(decreaseExpb)(ye',ym')innest3trimOnce(compressb(xe-ye,divMantbymxm))divMant::Basis->Mantissa->Mantissa->MantissadivMant_[]_=error"Number.Positional: division by zero"divMantbymxm0=snd$List.mapAccumL(\xmfullCompress->letz=div(headxm)(headym){- 'scaleMant' contains compression,
which is not much of a problem,
because it is always applied to @ym@.
That is, there is no nested call. -}dif=pumpFirstb(Poly.subxm(scaleMantbzym))cDif=iffullCompressthencompressMantbdifelsecompressSecondMantbdifin(cDif,z))xm0(cycle(replicate(b-1)False++[True]))divMantSlow::Basis->Mantissa->Mantissa->MantissadivMantSlow_[]=error"Number.Positional: division by zero"divMantSlowbym=List.unfoldr(\xm->letz=div(headxm)(headym)d=compressMantb(pumpFirstb(Poly.subxm(Poly.scalezym)))inJust(z,d))reciprocal::Basis->T->Treciprocalb=dividebone{- |
Fast division for small integral divisors,
which occur for instance in summands of power series.
-}divIntMant::Basis->Int->Mantissa->MantissadivIntMantbyxInit=List.unfoldr(\(r,rxs)->letrb=r*b(rbx,xs',run)=caserxsof[]->(rb,[],r/=0)(x:xs)->(rb+x,xs,True)(d,m)=divModrbxyintoMayberun(d,(m,xs')))(0,xInit)-- this version is simple but ignores the possibility of a terminating resultdivIntMantInf::Basis->Int->Mantissa->MantissadivIntMantInfby=mapfst.tail.scanl(\(_,r)x->divMod(r*b+x)y)(undefined,0).(++repeat0)divInt::Basis->Digit->T->TdivIntby(xe,xm)=-- (xe, divIntMant b y xm)letz=(xe,divIntMantbyxm){- Division by big integers may cause leading zeros.
Eliminate as many as we can expect from the division.
If the input number has leading zeros (it might be equal to zero),
then the result may have, too. -}tz=until((<=1).fst)(\(yi,zi)->(divyib,trimOncezi))(y,z)insndtz{- * algebraic functions -}sqrt::Basis->T->Tsqrtb=sqrtDriverbsqrtFPsqrtDriver::Basis->(Basis->FixedPoint->Mantissa)->T->TsqrtDriver__(xe,[])=(divxe2,[])sqrtDriverbsqrtFPworkerx=let(exe,ex0:exm)=ifodd(fstx)thendecreaseExpbxelsex(nxe,(nx0,nxm))=until(\xi->fst(sndxi)>=fromIntegralb^2)(nest2(decreaseExpFPb))(exe,(fromIntegralex0,exm))incompressb(divnxe2,sqrtFPworkerb(nx0,nxm))sqrtMant::Basis->Mantissa->MantissasqrtMant_[]=[]sqrtMantb(x:xs)=sqrtFPb(fromIntegralx,xs){- |
Square root.
We need a leading digit of type Integer,
because we have to collect up to 4 digits.
This presentation can also be considered as 'FixedPoint'.
ToDo:
Rigorously derive the minimal required magnitude
of the leading digit of the root.
Mathematically the @n@th digit of the square root
depends roughly only on the first @n@ digits of the input.
This is because @sqrt (1+eps) `equalApprox` 1 + eps\/2@.
However this implementation requires @2*n@ input digits
for emitting @n@ digits.
This is due to the repeated use of 'compressMant'.
It would suffice to fully compress only every @basis@th iteration (digit)
and compress only the second leading digit in each iteration.
Can the involved operations be made lazy enough to solve
@y = (x+frac)^2@
by
@frac = (y-x^2-frac^2) \/ (2*x)@ ?
-}sqrtFP::Basis->FixedPoint->MantissasqrtFPb(x0,xs)=lety0=round(NP.sqrt(fromIntegerx0::Double))dyx0=fromInteger(x0-fromIntegraly0^2)accumdif(e,ty)=-- (e,ty) == xm - (trunc j y)^2letyj=div(headdif+y0)(2*y0)newDif=pumpFirstb$LPoly.addShiftede(Poly.subdif(scaleMantb(2*yj)ty))[yj*yj]{- We could always compress the full difference number,
but it is not necessary,
and we save dependencies on less significant digits. -}cNewDif=ifmodeb==0thencompressMantbnewDifelsecompressSecondMantbnewDifin(cNewDif,yj)truncs=lazyInitsyy=y0:snd(List.mapAccumLaccum(pumpFirstb(dyx0:xs))(zip[1..](drop2truncs)))inysqrtNewton::Basis->T->TsqrtNewtonb=sqrtDriverbsqrtFPNewton{- |
Newton iteration doubles the number of correct digits in every step.
Thus we process the data in chunks of sizes of powers of two.
This way we get fastest computation possible with Newton
but also more dependencies on input than necessary.
The question arises whether this implementation still fits the needs
of computational reals.
The input is requested as larger and larger chunks,
and the input itself might be computed this way,
e.g. a repeated square root.
Requesting one digit too much,
requires the double amount of work for the input computation,
which in turn multiplies time consumption by a factor of four,
and so on.
Optimal fast implementation of one routine
does not preserve fast computation of composed computations.
The routine assumes, that the integer parts is at least @b^2.@
-}sqrtFPNewton::Basis->FixedPoint->MantissasqrtFPNewtonbInt(x0,xs)=letb=fromIntegralbIntchunkLengths=iterate(2*)1xChunks=map(mantissaToNumbInt)$snd$List.mapAccumL(\xcl->swap(splitAtPadZeroclx))xschunkLengthsbasisPowers=iterate(^2)btruncXs=scanl(\acc(bp,frac)->acc*bp+frac)x0(zipbasisPowersxChunks)accumy(bp,x)=letybp=y*bpnewY=div(ybp+div(x*divbpb)y)2in(newY,newY-ybp)y0=round(NP.sqrt(fromIntegerx0::Double))yChunks=snd$List.mapAccumLaccumy0(zipbasisPowers(tailtruncXs))yFrac=concat$zipWith(mantissaFromFixedIntbInt)chunkLengthsyChunksinfromIntegery0:yFrac{- |
List.inits is defined by
@inits = foldr (\x ys -> [] : map (x:) ys) [[]]@
This is too strict for our application.
> Prelude> List.inits (0:1:2:undefined)
> [[],[0],[0,1]*** Exception: Prelude.undefined
The following routine is more lazy than 'List.inits'
and even lazier than 'Data.List.HT.inits' from @utility-ht@ package,
but it is restricted to infinite lists.
This degree of laziness is needed for @sqrtFP@.
> Prelude> lazyInits (0:1:2:undefined)
> [[],[0],[0,1],[0,1,2],[0,1,2,*** Exception: Prelude.undefined
-}lazyInits::[a]->[[a]]lazyInits~(x:xs)=[]:map(x:)(lazyInitsxs){-
The lazy match above is irrefutable,
so the pattern @[]@ would never be reached.
-}{- * transcendent functions -}{- ** exponential functions -}expSeries::Basis->T->SeriesexpSeriesbxOrig=letx=negativeExpbxOrigxps=scanl(\pn->divIntbn(mulbxp))one[1..]inmap(\xp->(fstxp,xp))xps{- |
Absolute value of argument should be below 1.
-}expSmall::Basis->T->TexpSmallbx=seriesb(expSeriesbx)expSeriesLazy::Basis->T->SeriesexpSeriesLazybx@(xe,_)=letxps=scanl(\pn->divIntbn(mulbxp))one[1..]{- much effort for computing the residue exponents
without touching the arguments mantissa -}es::[Double]es=zipWith(-)(mapfromIntegral(iterate((1+xe)+)0))(scanl(+)0(map(logBase(fromIntegralb).fromInteger)[1..]))inzip(mapceilinges)xpsexpSmallLazy::Basis->T->TexpSmallLazybx=seriesb(expSeriesLazybx)exp::Basis->T->Texpbx=let(xInt,xFrac)=toFixedPointb(compressbx)yFrac=expSmallb(-1,xFrac){-
(xFrac0,xFrac1) = splitAt 2 xFrac
yFrac = mul b
-- slow convergence but simple argument
(expSmall b (-1, xFrac0))
-- fast convergence but big argument
(expSmall b (-3, xFrac1))
-}inintPowerbxIntyFrac(recipEConstb)(eConstb)intPower::Basis->Integer->T->T->T->TintPowerbexponneutralrecipXx=ifexpon>=0thencardPowerbexponneutralxelsecardPowerb(-expon)neutralrecipXcardPower::Basis->Integer->T->T->TcardPowerbexponneutralx=ifexpon>=0thenpowerAssociative(mulb)neutralxexponelseerror"negative exponent - use intPower"{- |
Residue estimates will only hold for exponents
with absolute value below one.
The computation is based on 'Int',
thus the denominator should not be too big.
(Say, at most 1000 for 1000000 digits.)
It is not optimal to split the power into pure root and pure power
(that means, with integer exponents).
The root series can nicely handle all exponents,
but for exponents above 1 the series summands rises at the beginning
and thus make the residue estimate complicated.
For powers with integer exponents the root series turns
into the binomial formula,
which is just a complicated way to compute a power
which can also be determined by simple multiplication.
-}powerSeries::Basis->Rational->T->SeriespowerSeriesbexponxOrig=letscaleRatniyi=divIntb(fromInteger(denominatoryi)*ni).scaleSimple(fromInteger(numeratoryi))x=negativeExpb(subbxOrigone)xps=scanl(\pfac->uncurryscaleRatfac(mulbxp))one(zip[1..](iterate(subtract1)expon))inmap(\xp->(fstxp,xp))xpspowerSmall::Basis->Rational->T->TpowerSmallbyx=seriesb(powerSeriesbyx)power::Basis->Rational->T->Tpowerbexponx=letnum=numeratorexponden=denominatorexponrootX=rootbdenxinintPowerbnumone(reciprocalbrootX)rootXroot::Basis->Integer->T->Trootbexponx=letestimate=liftDoubleApproxb(**(1/fromIntegerexpon))xestPower=cardPowerbexpononeestimateresidue=dividebxestPowerinmulbestimate(powerSmallb(1%fromIntegralexpon)residue){- |
Absolute value of argument should be below 1.
-}cosSinhSmall::Basis->T->(T,T)cosSinhSmallbx=let(coshXps,sinhXps)=unzip(sliceVertPair(expSeriesbx))in(seriesbcoshXps,seriesbsinhXps){- |
Absolute value of argument should be below 1.
-}cosSinSmall::Basis->T->(T,T)cosSinSmallbx=let(coshXps,sinhXps)=unzip(sliceVertPair(expSeriesbx))alternates=zipWith3if'(cycle[True,False])s(map(\(e,y)->(e,negby))s)in(seriesb(alternatecoshXps),seriesb(alternatesinhXps)){- |
Like 'cosSinSmall' but converges faster.
It calls @cosSinSmall@ with reduced arguments
using the trigonometric identities
@
cos (4*x) = 8 * cos x ^ 2 * (cos x ^ 2 - 1) + 1
sin (4*x) = 4 * sin x * cos x * (1 - 2 * sin x ^ 2)
@
Note that the faster convergence is hidden by the overhead.
The same could be achieved with a fourth power of a complex number.
-}cosSinFourth::Basis->T->(T,T)cosSinFourthbx=let(cosx,sinx)=cosSinSmallb(divIntb4x)sinx2=mulbsinxsinxcosx2=mulbcosxcosxsincosx=mulbsinxcosxin(addbone(scaleb8(mulbcosx2(subbcosx2one))),scaleb4(mulbsincosx(subbone(scaleb2sinx2))))cosSin::Basis->T->(T,T)cosSinbx=letpi2=divIntb2(piConstb){- @compress@ ensures that the leading digit of the fractional part
is close to zero -}(quadrant,frac)=toFixedPointb(compressb(dividebxpi2))-- it's possibly faster if we subtract quadrant*pi/4wrapped=ifquadrant==0thenxelsemulbpi2(-1,frac)(cosW,sinW)=cosSinSmallbwrappedincasemodquadrant4of0->(cosW,sinW)1->(negbsinW,cosW)2->(negbcosW,negbsinW)3->(sinW,negbcosW)_->error"error in implementation of 'mod'"tan::Basis->T->Ttanbx=uncurry(flip(divideb))(cosSinbx)cot::Basis->T->Tcotbx=uncurry(divideb)(cosSinbx){- ** logarithmic functions -}lnSeries::Basis->T->SerieslnSeriesbxOrig=letx=negativeExpb(subbxOrigone)mx=negbxxps=zipWith(divIntb)[1..](iterate(mulbmx)x)inmap(\xp->(fstxp,xp))xpslnSmall::Basis->T->TlnSmallbx=seriesb(lnSeriesbx){- |
@
x' = x - (exp x - y) \/ exp x
= x + (y * exp (-x) - 1)
@
First, the dependencies on low-significant places are currently
much more than mathematically necessary.
Check
@
*Number.Positional> expSmall 1000 (-1,100 : replicate 16 0 ++ [undefined])
(0,[1,105,171,-82,76*** Exception: Prelude.undefined
@
Every multiplication cut off two trailing digits.
@
*Number.Positional> nest 8 (mul 1000 (-1,repeat 1)) (-1,100 : replicate 16 0 ++ [undefined])
(-9,[101,*** Exception: Prelude.undefined
@
Possibly the dependencies of expSmall
could be resolved by not computing @mul@ immediately
but computing @mul@ series which are merged and subsequently added.
But this would lead to an explosion of series.
Second, even if the dependencies of all atomic operations
are reduced to a minimum,
the mathematical dependencies of the whole iteration function
are less than the sums of the parts.
Lets demonstrate this with the square root iteration.
It is
@
(1.4140 + 2/1.4140) / 2 == 1.414213578500707
(1.4149 + 2/1.4149) / 2 == 1.4142137288854335
@
That is, the digits @213@ do not depend mathematically on @x@ of @1.414x@,
but their computation depends.
Maybe there is a glorious trick to reduce the computational dependencies
to the mathematical ones.
-}lnNewton::Basis->T->TlnNewtonby=letestimate=liftDoubleApproxblogyexpRes=mulby(expSmallb(negbestimate))-- try to reduce dependencies by feeding expSmall with a small argumentresidue=subb(mulbexpRes(expSmallLazyb(negbresTrim)))oneresTrim=-- (-3, replicate 4 0 ++ alignMant b (-7) residue)alignb(-mantLengthDoubleb)residuelazyAdd(xe,xm)(ye,ym)=(xe,LPoly.addShifted(xe-ye)xmym)x=lazyAddestimateresTriminxlnNewton'::Basis->T->TlnNewton'by=letestimate=liftDoubleApproxblogyresidue=subb(mulby(expSmallb(negbx)))one-- sub b (mul b y (expSmall b (neg b estimate))) one-- sub b (mul b y (expSmall b (neg b-- (fst estimate, snd estimate ++ [undefined])))) oneresTrim=-- align b (-6) residuealignb(-mantLengthDoubleb)residue-- align returns the new exponent immediately-- nest (mantLengthDouble b) trimOnce residue-- negativeExp b residuelazyAdd(xe,xm)(ye,ym)=(xe,LPoly.addShifted(xe-ye)xmym)x=lazyAddestimateresTrim-- add b estimate resTrim-- LPoly.add checks for empty lists and is thus too strictinxln::Basis->T->Tlnbx@(xe,_)=lete=round(log(fromIntegralb)*fromIntegralxe::Double)ei=fromIntegraley=trim$ife<0thenpowerAssociative(mulb)x(eConstb)(-ei)elsepowerAssociative(mulb)x(recipEConstb)eiestimate=liftDoubleApproxblogyresidue=mulb(expSmallb(negbestimate))yinaddSomeb[(0,[e]),estimate,lnSmallbresidue]{- |
This is an inverse of 'cosSin',
also known as @atan2@ with flipped arguments.
It's very slow because of the computation of sinus and cosinus.
However, because it uses the 'atan2' implementation as estimator,
the final application of arctan series should converge rapidly.
It could be certainly accelerated by not using cosSin
and its fiddling with pi.
Instead we could analyse quadrants before calling atan2,
then calling cosSinSmall immediately.
-}angle::Basis->(T,T)->Tangleb(cosx,sinx)=letwd=atan2(toDoublebsinx)(toDoublebcosx)wApprox=fromDoubleApproxbwd(cosApprox,sinApprox)=cosSinbwApprox(cosD,sinD)=(addb(mulbcosxcosApprox)(mulbsinxsinApprox),subb(mulbsinxcosApprox)(mulbcosxsinApprox))sinDSmall=negativeExpbsinDinaddbwApprox(arctanSmallb(dividebsinDSmallcosD)){- |
Arcus tangens of arguments with absolute value less than @1 \/ sqrt 3@.
-}arctanSeries::Basis->T->SeriesarctanSeriesbxOrig=letx=negativeExpbxOrigmx2=negb(mulbxx)xps=zipWith(divIntb)[1,3..](iterate(mulbmx2)x)inmap(\xp->(fstxp,xp))xpsarctanSmall::Basis->T->TarctanSmallbx=seriesb(arctanSeriesbx){- |
Efficient computation of Arcus tangens of an argument of the form @1\/n@.
-}arctanStem::Basis->Int->TarctanStembn=letx=(0,divIntMantbn[1])divN2=divIntbn.divIntb(-n){- this one can cause overflows in piConst too easily
mn2 = - n*n
divN2 = divInt b mn2
-}xps=zipWith(divIntb)[1,3..](iterate(trim.divN2)x)inseriesb(map(\xp->(fstxp,xp))xps){- |
This implementation gets the first decimal place for free
by calling the arcus tangens implementation for 'Double's.
-}arctan::Basis->T->Tarctanbx=letestimate=liftDoubleRoughbatanxtanEst=tanbestimateresidue=divideb(subbxtanEst)(addbone(mulbxtanEst))inaddSomeb[estimate,arctanSmallbresidue]{- |
A classic implementation without ''cheating''
with floating point implementations.
For @x < 1 \/ sqrt 3@
(@1 \/ sqrt 3 == tan (pi\/6)@)
use @arctan@ power series.
(@sqrt 3@ is approximately @19\/11@.)
For @x > sqrt 3@
use
@arctan x = pi\/2 - arctan (1\/x)@
For other @x@ use
@arctan x = pi\/4 - 0.5*arctan ((1-x^2)\/2*x)@
(which follows from
@arctan x + arctan y == arctan ((x+y) \/ (1-x*y))@
which in turn follows from complex multiplication
@(1:+x)*(1:+y) == ((1-x*y):+(x+y))@
If @x@ is close to @sqrt 3@ or @1 \/ sqrt 3@ the computation is quite inefficient.
-}arctanClassic::Basis->T->TarctanClassicbx=letabsX=absolutexpi2=divIntb2(piConstb)inselect(divIntb2(subbpi2(arctanSmallb(divIntb2(subb(reciprocalbx)x)))))[(lessApproxb(-5)absX(fromBaseRationalb(11%19)),arctanSmallbx),(lessApproxb(-5)(fromBaseRationalb(19%11))absX,subbpi2(arctanSmallb(reciprocalbx)))]{- * constants -}{- ** elementary -}zero::Tzero=(0,[])one::Tone=(0,[1])minusOne::TminusOne=(0,[-1]){- ** transcendental -}eConst::Basis->TeConstb=expSmallbonerecipEConst::Basis->TrecipEConstb=expSmallbminusOnepiConst::Basis->TpiConstb=letnumCompress=takeWhile(0/=)(iterate(flipdivb)(4*(44+7+12+24)))stArcTankden=scaleSimplek(arctanStembden)sum'=addSomeb[stArcTan4457,stArcTan7239,stArcTan(-12)682,stArcTan2412943]infoldl(const.compressb)(scaleSimple4sum')numCompress{- * auxilary functions -}sliceVertPair::[a]->[(a,a)]sliceVertPair(x0:x1:xs)=(x0,x1):sliceVertPairxssliceVertPair[]=[]sliceVertPair_=error"odd number of elements"{-
Pi as a zero of trigonometric functions. -
Is a corresponding computation that bad?
Newton converges quadratically,
but the involved trigonometric series converge only slightly more than linearly.
-- lift cos to higher frequencies, in order to shift the zero to smaller values, which let trigonometric series converge faster
take 10 $ Numerics.Newton.zero 0.7 (\x -> (cos (2*x), -2 * sin (2*x)))
(\x -> (2 * cos x ^ 2 - 1, -4 * cos x * sin x))
(\x -> (cos x ^ 2 - sin x ^ 2, -4 * cos x * sin x))
(\x -> (tan x ^ 2 - 1, 4 * tan x))
-- compute arctan as inverse of tan by Newton
zero 0.7 (\x -> (tan x - 1, 1 + tan x ^ 2))
zero 0.7 (\x -> (tan x - 1, 1 / cos x ^ 2))
iterate (\x -> x + (cos x - sin x) * cos x) 0.7
iterate (\x -> x + (cos x - sin x) * sqrt 0.5) 0.7
iterate (\x -> x + cos x ^ 2 - sin x * cos x) 0.7
iterate (\x -> x + 0.5 - sin x * cos x) 0.7
iterate (\x -> x + cos x ^ 2 - 0.5) 0.7
-- compute section of tan and cot
zero 0.7 (\x -> (tan x - 1 / tan x, (1 + tan x ^ 2) * (1 + 1 / tan x ^ 2))
zero 0.7 (\x -> ((tan x ^ 2 - 1) * tan x, (1 + tan x ^ 2) ^ 2)
iterate (\x -> x - (sin x ^ 2 - cos x ^ 2) * sin x * cos x) 0.7
iterate (\x -> x - (sin x ^ 2 - cos x ^ 2) * 0.5) 0.7
iterate (\x -> x + 1/2 - sin x ^ 2) 0.7
For using the last formula,
the n-th digit of (sin x) must depend only on the n-th digit of x.
The same holds for (^2).
This means that no interim carry compensation is possible.
This will certainly force usage of Integer for digits,
otherwise the multiplication will overflow sooner or later.
-}