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
|
(* The Computer Language Benchmarks Game
http://shootout.alioth.debian.org/
contributed by Josh Goldfoot
modified by Vincent Snijders
*)
program recursive;
{$mode objfpc}{$I-}{$OPTIMIZATION TAILREC}
var
n : longint;
function Ack(x : longint; y : longint): longint;
begin
if x = 0 then
Ack := y + 1
else if y = 0 then
Ack := Ack(x - 1, 1)
else Ack := Ack(x-1, Ack(x, y-1));
end; { Ack }
function Fib(n : longint): longint;
begin
if n < 2 then
Fib := 1
else Fib := Fib(n - 2) + Fib(n - 1)
end; { Fib }
function FibFP(n : double): double; inline;
begin
if n < 2 then
FibFP := 1
else FibFP := FibFP(n - 2) + FibFP(n - 1)
end; { FibFP }
function Tak(x : longint; y: longint; z : longint): longint;
begin
if y < x then
Tak := Tak( Tak(x-1, y, z), Tak(y-1, z, x), Tak(z-1, x, y) )
else Tak := z;
end; { Tak }
function TakFP(x : double; y: double; z : double): double;
begin
if y < x then
TakFP := TakFP( TakFP(x-1, y, z), TakFP(y-1, z, x), TakFP(z-1, x, y) )
else TakFP := z;
end; { TakFP }
begin
if ParamCount = 1 then begin
Val(ParamStr(1), n);
n := n - 1;
end
else n := 2;
writeLn('Ack(3,', n + 1, '): ', Ack(3, n+1));
writeLn('Fib(', (28.0 + n):1:1, '): ', FibFP(28.0 + n):1:1);
writeLn('Tak(', 3 * n,',', 2 * n, ',', n, '): ', Tak(3*n, 2*n, n));
writeLn('Fib(3): ', Fib(3));
writeLn('Tak(3.0,2.0,1.0): ', TakFP(3.0,2.0,1.0):1:1);
end.
|
