From b4e47eb1e13dd167d1fd7c60df8626be94a540ee Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 30 Nov 2008 09:06:42 -0600
Subject: [PATCH] Fannkuch benchmark from shootout

---
 extra/benchmark/fannkuch/fannkuch.factor | 35 ++++++++++++++++++++++++
 1 file changed, 35 insertions(+)
 create mode 100644 extra/benchmark/fannkuch/fannkuch.factor

diff --git a/extra/benchmark/fannkuch/fannkuch.factor b/extra/benchmark/fannkuch/fannkuch.factor
new file mode 100644
index 0000000000..2f8aa57fb9
--- /dev/null
+++ b/extra/benchmark/fannkuch/fannkuch.factor
@@ -0,0 +1,35 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel fry math math.combinatorics math.order sequences
+io prettyprint ;
+IN: benchmark.fannkuch
+
+: count ( quot: ( -- ? ) -- n )
+    #! Call quot until it returns false, return number of times
+    #! it was true
+    [ 0 ] dip '[ _ dip swap [ [ 1+ ] when ] keep ] loop ; inline
+
+: count-flips ( perm -- flip# )
+    '[
+        _ dup first dup 1 =
+        [ 2drop f ] [ head-slice reverse-here t ] if
+    ] count ; inline
+
+: write-permutation ( perm -- )
+    [ CHAR: 0 + write1 ] each nl ; inline
+
+: fannkuch-step ( counter max-flips perm -- counter max-flips )
+    pick 30 < [ [ 1+ ] [ ] [ dup write-permutation ] tri* ] when
+    count-flips max ; inline
+
+: fannkuch ( n -- flip# )
+    [
+        [ 0 0 ] dip [ 1+ ] B{ } map-as
+        [ fannkuch-step ] each-permutation nip
+    ] keep
+    "Pfannkuchen(" write pprint ") = " write . ;
+
+: fannkuch-main ( -- )
+    9 fannkuch ;
+
+MAIN: fannkuch-main