1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
program pi;
{$ifdef fpc}
{$mode objfpc}
{$endif fpc}
{$APPTYPE CONSOLE}
{$h+}
uses
timer;
function ComputePi(NumDigits: Integer): string;
var
A: array of LongInt;
I, J, K, P, Q, X, Nines, Predigit: Integer;
PiLength: Integer;
begin
start;
SetLength(A, 10*NumDigits div 3);
SetLength(Result, NumDigits+1);
PiLength := 1;
for I := Low(A) to High(A) do
A[I] := 2;
Nines := 0;
Predigit := 0;
for J := 0 to NumDigits-1 do
begin
Q := 0;
P := 2 * High(A) + 1;
for I := High(A) downto Low(A) do
begin
X := 10*A[I] + Q*(I+1);
A[I] := X mod P;
Q := X div P;
P := P - 2;
end;
A[Low(A)] := Q mod 10;
Q := Q div 10;
if Q = 9 then
Inc(Nines)
else if Q = 10 then
begin
Result[PiLength] := Chr(Predigit + 1 + Ord('0'));
for K := 1 to Nines do
Result[PiLength+K] := '0';
PiLength := PiLength + Nines + 1;
Predigit := 0;
Nines := 0;
end
else
begin
Result[PiLength] := Chr(Predigit + Ord('0'));
Predigit := Q;
for K := 1 to Nines do
Result[PiLength+K] := '9';
PiLength := PiLength + Nines + 1;
Nines := 0;
end;
end;
Result[PiLength] := Chr(Predigit + Ord('0'));
stop;
end;
var
NumDigits: Integer;
Code: Integer;
F: TextFile;
result : string;
begin
if ParamCount = 0 then
WriteLn('usage: pi #DIGITS [FILE]')
else
begin
Val(ParamStr(1), NumDigits, Code);
if Code <> 0 then
begin
WriteLn('Invalid # digits: ', ParamStr(1));
Halt(1);
end;
if ParamCount > 1 then
begin
AssignFile(F, ParamStr(2));
Rewrite(F);
WriteLn(F, ComputePi(NumDigits));
CloseFile(F);
end
else
begin
result:=ComputePi(NumDigits);
WriteLn(result);
end;
end;
end.
|
