From 1117a58f9fe34f073557f3f215fc15154b7297e1 Mon Sep 17 00:00:00 2001 From: Vincent Snijders Date: Wed, 11 Oct 2006 21:03:25 +0000 Subject: [PATCH] + added binarytrees benchmark git-svn-id: trunk@4864 - --- .gitattributes | 2 + .../bench/shootout/io/binarytrees-output.txt | 6 ++ tests/bench/shootout/src/binarytrees.pp | 91 +++++++++++++++++++ tests/bench/shootout/src/nsieve.pp | 74 +++++++-------- 4 files changed, 136 insertions(+), 37 deletions(-) create mode 100644 tests/bench/shootout/io/binarytrees-output.txt create mode 100644 tests/bench/shootout/src/binarytrees.pp diff --git a/.gitattributes b/.gitattributes index 31819f5058..b769281970 100644 --- a/.gitattributes +++ b/.gitattributes @@ -5103,6 +5103,7 @@ tests/bench/drystone.pas svneol=native#text/plain tests/bench/pi.c -text tests/bench/pi.pp svneol=native#text/plain tests/bench/shootout/README.txt svneol=native#text/plain +tests/bench/shootout/io/binarytrees-output.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 @@ -5148,6 +5149,7 @@ tests/bench/shootout/obsolete/strcat.pp svneol=native#text/plain tests/bench/shootout/obsolete/takfp.pp svneol=native#text/plain tests/bench/shootout/obsolete/wc.pp svneol=native#text/plain tests/bench/shootout/src/bench.c -text +tests/bench/shootout/src/binarytrees.pp svneol=native#text/plain 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 diff --git a/tests/bench/shootout/io/binarytrees-output.txt b/tests/bench/shootout/io/binarytrees-output.txt new file mode 100644 index 0000000000..c8f333d504 --- /dev/null +++ b/tests/bench/shootout/io/binarytrees-output.txt @@ -0,0 +1,6 @@ +stretch tree of depth 11 check: -1 +2048 trees of depth 4 check: -2048 +512 trees of depth 6 check: -512 +128 trees of depth 8 check: -128 +32 trees of depth 10 check: -32 +long lived tree of depth 10 check: -1 diff --git a/tests/bench/shootout/src/binarytrees.pp b/tests/bench/shootout/src/binarytrees.pp new file mode 100644 index 0000000000..bf50575ed2 --- /dev/null +++ b/tests/bench/shootout/src/binarytrees.pp @@ -0,0 +1,91 @@ +{ The Great Computer Language Shootout + http://shootout.alioth.debian.org + + contributed by Ales Katona +} + +program BinaryTrees; + +{$mode objfpc} + +type + PNode = ^TNode; + TNode = record + l, r: PNode; + i: Longint; + end; + +function CreateNode(l2, r2: PNode; const i2: Longint): PNode; +begin + Result := GetMem(SizeOf(TNode)); + Result^.l:=l2; + Result^.r:=r2; + Result^.i:=i2; +end; + +procedure DestroyNode(ANode: PNode); +begin + if ANode^.l <> nil then begin + DestroyNode(ANode^.l); + DestroyNode(ANode^.r); + end; + FreeMem(ANode, SizeOf(TNode)); +end; + +function CheckNode(ANode: PNode): Longint; +begin + if ANode^.l = nil then + Result:=ANode^.i + else + Result:=CheckNode(ANode^.l) + ANode^.i - CheckNode(ANode^.r); +end; + +function Make(i, d: Longint): PNode; +begin + if d = 0 then Result:=CreateNode(nil, nil, i) + else Result:=CreateNode(Make(2 * i - 1, d - 1), Make(2 * i, d - 1), i); +end; + +const + mind = 4; + +var + maxd : Longint = 10; + strd, + iter, + c, d, i : Longint; + tree, llt : PNode; + +begin + if ParamCount = 1 then + Val(ParamStr(1), maxd); + + if maxd < mind+2 then + maxd := mind + 2; + + strd:=maxd + 1; + tree:=Make(0, strd); + Writeln('stretch tree of depth ', strd, #9' check: ', CheckNode(tree)); + DestroyNode(tree); + + llt:=Make(0, maxd); + + d:=mind; + while d <= maxd do begin + iter:=1 shl (maxd - d + mind); + c:=0; + for i:=1 to Iter do begin + tree:=Make(i, d); + c:=c + CheckNode(tree); + DestroyNode(tree); + tree:=Make(-i, d); + c:=c + CheckNode(tree); + DestroyNode(tree); + end; + Writeln(2 * Iter, #9' trees of depth ', d, #9' check: ', c); + Inc(d, 2); + end; + + Writeln('long lived tree of depth ', maxd, #9' check: ', CheckNode(llt)); + DestroyNode(llt); +end. diff --git a/tests/bench/shootout/src/nsieve.pp b/tests/bench/shootout/src/nsieve.pp index 8e6cdba86a..0caa2c24da 100644 --- a/tests/bench/shootout/src/nsieve.pp +++ b/tests/bench/shootout/src/nsieve.pp @@ -1,41 +1,41 @@ -{ Sieve of Erathostenes } +{ The Computer Language Shootout + http://shootout.alioth.debian.org -program sieve; -uses SysUtils; + contributed by Joost van der Sluis +} -var - NUM, i, k, count : integer; - flags : array[0..8192] of integer; +program nsieve; + +{$mode objfpc} + +var n : integer; + +procedure primes(n : integer); inline; +var flags : array of boolean; + size,i,j,count : integer; +begin + size := 10000 shl n; + SetLength(flags, size+1); + for i := 2 to size do flags[i] := true; +//fillchar(flags[0],length(flags),ord(true)); + count := 0; + for i := 2 to size do + if flags[i] then + begin + count := count + 1; + j := i + i; + while j <= size do begin +// flags[j] := false; + if flags[j] then flags[j] := false; + j := j + i; + end; + end; + writeln('Primes up to', size:9, count:9); +end; begin - if ParamCount = 0 then - NUM := 1 - else - NUM := StrToInt(ParamStr(1)); - - if NUM < 1 then NUM := 1; - - while NUM > 0 do - begin - Dec(NUM); - count := 0; - for i := 0 to 8192 do - begin - flags[i] := i; - end; - for i := 2 to 8192 do - begin - if flags[i] <> -1 then - begin - k := i+i; - while k <= 8192 do - begin - flags[k] := -1; - Inc(k, i); - end; - Inc(count); - end; - end; - end; - WriteLn('Count: ' + IntToStr(Count)); -end. + val(ParamStr(1), n); + primes(n); + primes(n-1); + primes(n-2); +end. \ No newline at end of file