steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add binary-trees benchmark from shootout

db4
Slava Pestov 2008-04-20 06:28:18 -05:00
parent 8ce5760fcc
commit 7dd8ca150e
1 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
extra/benchmark/binary-trees/binary-trees.factor
View File

@ -28,7 +28,7 @@ M: f item-check drop 0 ;
: stretch-tree ( max-depth -- ) : stretch-tree ( max-depth -- )
1 + 0 over bottom-up-tree item-check 1 + 0 over bottom-up-tree item-check
[ "stretch tree of depth " write pprint ] [ "stretch tree of depth " write pprint ]
[ "\t check: " write ] bi* ; [ "\t check: " write . ] bi* ;
:: long-lived-tree ( max-depth -- ) :: long-lived-tree ( max-depth -- )
0 max-depth bottom-up-tree 0 max-depth bottom-up-tree
@ -36,8 +36,8 @@ M: f item-check drop 0 ;
min-depth max-depth 2 <range> [| depth | min-depth max-depth 2 <range> [| depth |
max-depth depth - min-depth + 2^ [ max-depth depth - min-depth + 2^ [
[1,b] 0 [ [1,b] 0 [
[ depth ] [ depth neg ] bi dup neg
[ bottom-up-tree item-check + ] 2bi@ [ depth bottom-up-tree item-check + ] bi@
] reduce ] reduce
] ]
[ 2 * ] bi [ 2 * ] bi
@ -47,3 +47,9 @@ M: f item-check drop 0 ;
"long lived tree of depth " write max-depth pprint "long lived tree of depth " write max-depth pprint
"\t check: " write item-check . ; "\t check: " write item-check . ;
: binary-trees ( n -- )
min-depth 2 + max [ stretch-tree ] [ long-lived-tree ] bi ;
: binary-trees-main ( -- )
16 binary-trees ;