Older Version Newer Version

tenochtitlanuk tenochtitlanuk May 27, 2006

Back to my home page at [[tenochtitlanuk]]

' PI c Best algorithm I know to calculate multi-precision PI
'
' Uses the ATN( a +b) expansion

' Result is in clipboard at end ready to paste where you wish
' Based on an Apple (the original!) program from 'Kilobaud' mag
' Assembles long, high precision numbers from 5-digit fragments.

blocklength = 5
H = 10^blocklength
numberofdp =1000
B = numberofdp /blocklength +2
term = 1.66 *numberofdp
DIM product( B)
DIM term( B)
DIM quotient( B)
term( B -1) =H /2
product( B -1) =H /2
nomainwin
UpperLeftX = 20
UpperLeftY = 20
WindowWidth = 800
WindowHeight = 540
button #w, "Quit?", [quit], LR, 50, 30
texteditor #w.t, 20, 20, 760, 400
open "PI Calculator output window" for window as #w
#w.t "!setfocus"
#w.t "!font courier_new 10"
#w "trapclose [quit]"
FOR N =1 TO term
scan
X =2 *N -1
carry =0
FOR I =1 TO B
term( I) =term( I) *X +carry
carry =int( term( I) / H)
term( I) =term( I) -carry *H
NEXT I
carry =0
FOR I =1 TO B
term( I) =term( I) *X +carry
carry =int( term( I) / H)
term( I) =term( I) -carry *H
NEXT I
X =8 *N
carry =0
FOR I =B TO 1 STEP -1
Z =term( I) +carry
quotient =INT( Z /X)
term( I) =quotient
carry =H *( Z -quotient *X)
NEXT I
X =2 *N +1
carry =0
FOR I =B TO 1 STEP -1
Z =term( I) +carry
quotient =INT( Z /X)
term( I) =quotient
carry =H *( Z -quotient *X)
NEXT I
carry =0
FOR I =1 TO B
product( I) =product( I) +term( I) +carry
carry =0
IF product( I) >=H THEN
product( I) =product( I) -H
carry =1
ELSE
carry =0
END IF
NEXT I
carry =0
for jf =1 to B
quotient( jf) =product( jf)
next jf
FOR I =1 TO B
quotient( I) =quotient( I) *6 +carry
carry =int( quotient( I) / H)
quotient( I) =quotient( I) -carry *H
NEXT I
op$ =str$( quotient( B))+ "."' +chr$(10)
cr =0
FOR I =B -1 TO 1 STEP -1
cr =cr+1
op$ =op$ +RIGHT$( STR$( quotient( I) +10 *H), blocklength)
if cr>=16 then
cr =0
op$ =op$ +chr$(10)
end if
NEXT I
#w.t "!cls"
#w.t "!contents op$"
NEXT N
[quit]
notice "Calculation may have been interrupted!" + chr$(13) + "Result in clipboard may be incomplete!"
[quit2]
if left$( op$, 50) <>left$( "3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930381964428810975665933446128475648233786783165271201909145648566923460348610454326648213393607260249141273724587006606315588174881520920962829254091715364367892590360011330530548820466521384146951941511609", 50) then notice "Whoops!" + chr$(13) + "A little local difficulty here!" +chr$( 13) +"First 200 checked and contain errors.."
#w.t, "!selectall"
#w.t, "!copy"
close #w
end