From 1c93ac733cc4cd25a45929ccdff52c9f8fa0bc6e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 14 Jul 2008 00:49:09 -0500 Subject: [PATCH] Two new benchmarks --- extra/benchmark/beust1/beust1.factor | 14 ++++++++++ extra/benchmark/beust2/beust2.factor | 39 ++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+) create mode 100644 extra/benchmark/beust1/beust1.factor create mode 100644 extra/benchmark/beust2/beust2.factor diff --git a/extra/benchmark/beust1/beust1.factor b/extra/benchmark/beust1/beust1.factor new file mode 100644 index 0000000000..9849ac2dbe --- /dev/null +++ b/extra/benchmark/beust1/beust1.factor @@ -0,0 +1,14 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: math.ranges math.parser math.vectors sets sequences +kernel io ; +IN: benchmark.beust1 + +: count-numbers ( max -- n ) + 1 [a,b] [ number>string all-unique? ] count ; inline + +: beust ( -- ) + 10000000 count-numbers + number>string " unique numbers." append print ; + +MAIN: beust diff --git a/extra/benchmark/beust2/beust2.factor b/extra/benchmark/beust2/beust2.factor new file mode 100644 index 0000000000..8f794fb1c2 --- /dev/null +++ b/extra/benchmark/beust2/beust2.factor @@ -0,0 +1,39 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: math math.ranges math.parser sequences kernel io locals ; +IN: benchmark.beust2 + +:: (count-numbers) ( remaining first value used max listener -- ? ) + 10 first - [| i | + [let* | digit [ i first + ] + mask [ digit 2^ ] + value' [ i value + ] | + used mask bitand zero? [ + value max > [ t ] [ + remaining 1 <= [ + listener call f + ] [ + remaining 1- + 0 + value' 10 * + used mask bitor + max + listener + (count-numbers) + ] if + ] if + ] [ f ] if + ] + ] contains? ; inline + +:: count-numbers ( max listener -- ) + 10 [ 1+ 1 1 0 max listener (count-numbers) ] contains? drop ; + inline + +:: beust ( -- ) + [let | i! [ 0 ] | + 10000000000 [ i 1+ i! ] count-numbers + i number>string " unique numbers." append print + ] ; + +MAIN: beust