Browse Source

+ recursive benchmark

git-svn-id: trunk@4858 -
Vincent Snijders 19 years ago
parent
commit
ce9cbe2401

+ 2 - 0
.gitattributes

@@ -5105,6 +5105,7 @@ tests/bench/pi.pp svneol=native#text/plain
 tests/bench/shootout/README.txt svneol=native#text/plain
 tests/bench/shootout/io/moments.in -text
 tests/bench/shootout/io/moments.out -text
+tests/bench/shootout/io/recursive-output.txt svneol=native#text/plain
 tests/bench/shootout/io/rev.out -text
 tests/bench/shootout/io/revfile.in -text
 tests/bench/shootout/io/revfile.out -text
@@ -5149,6 +5150,7 @@ tests/bench/shootout/obsolete/wc.pp svneol=native#text/plain
 tests/bench/shootout/src/bench.c -text
 tests/bench/shootout/src/hello.pp svneol=native#text/plain
 tests/bench/shootout/src/nsieve.pp svneol=native#text/plain
+tests/bench/shootout/src/recursive.pp svneol=native#text/plain
 tests/bench/shootout/src/sumcol.pp svneol=native#text/plain
 tests/bench/shortbench.pp svneol=native#text/plain
 tests/bench/timer.pas svneol=native#text/plain

+ 5 - 0
tests/bench/shootout/io/recursive-output.txt

@@ -0,0 +1,5 @@
+Ack(3,3): 61
+Fib(30.0): 1346269.0
+Tak(6,4,2): 3
+Fib(3): 3
+Tak(3.0,2.0,1.0): 2.0

+ 64 - 0
tests/bench/shootout/src/recursive.pp

@@ -0,0 +1,64 @@
+(* The Computer Language Shootout
+   http://shootout.alioth.debian.org/
+
+   contributed by Josh Goldfoot
+   modified by Vincent Snijders
+*)
+
+program recursive;
+
+{$I-}
+
+var
+   n : integer;
+
+function Ack(x : integer; y : integer): integer;
+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 : integer): integer;
+begin
+   if n < 2 then
+      Fib := 1
+   else Fib := Fib(n - 2) + Fib(n - 1)
+end; { Fib }
+
+function FibFP(n : double): double;
+begin
+   if n < 2 then
+      FibFP := 1
+   else FibFP := FibFP(n - 2) + FibFP(n - 1)
+end; { FibFP }
+
+function Tak(x : integer; y: integer; z : integer): integer;
+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.

+ 15 - 10
tests/bench/shootout/src/sumcol.pp

@@ -1,14 +1,19 @@
-{ Sum a Column of Integers }
+{ The Great Computer Language Shootout
+  http://shootout.alioth.debian.org
+
+  contributed by Ales Katona
+}
 
 program sumcol;
 
-var
-    num, tot: longint;
+{$mode objfpc}
+
+var num, tot: longint;
+
 begin
-    While Not Eof(input) Do
-    begin
-        ReadLn(input, num);
-        tot := tot + num;
-    end;
-    WriteLn(tot);
-end.
+  while not Eof(input) do begin
+    ReadLn(input, num);
+    tot := tot + num;
+  end;
+  WriteLn(tot);
+end.