From ce9cbe24012b4b97e6032209d9ceda0770d4ae9e Mon Sep 17 00:00:00 2001 From: Vincent Snijders Date: Wed, 11 Oct 2006 09:26:15 +0000 Subject: [PATCH] + recursive benchmark git-svn-id: trunk@4858 - --- .gitattributes | 2 + tests/bench/shootout/io/recursive-output.txt | 5 ++ tests/bench/shootout/src/recursive.pp | 64 ++++++++++++++++++++ tests/bench/shootout/src/sumcol.pp | 25 +++++--- 4 files changed, 86 insertions(+), 10 deletions(-) create mode 100644 tests/bench/shootout/io/recursive-output.txt create mode 100644 tests/bench/shootout/src/recursive.pp diff --git a/.gitattributes b/.gitattributes index d3b32d0bb9..31819f5058 100644 --- a/.gitattributes +++ b/.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 diff --git a/tests/bench/shootout/io/recursive-output.txt b/tests/bench/shootout/io/recursive-output.txt new file mode 100644 index 0000000000..ee3ea9bb49 --- /dev/null +++ b/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 diff --git a/tests/bench/shootout/src/recursive.pp b/tests/bench/shootout/src/recursive.pp new file mode 100644 index 0000000000..264a21055e --- /dev/null +++ b/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. diff --git a/tests/bench/shootout/src/sumcol.pp b/tests/bench/shootout/src/sumcol.pp index f542f849cc..bff56412ea 100644 --- a/tests/bench/shootout/src/sumcol.pp +++ b/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. \ No newline at end of file