extra/benchmark/fannkuch/fannkuch.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel math math.combinatorics math.order sequences
   4 io prettyprint ;
   5 IN: benchmark.fannkuch
   6
   7 : count ( quot: ( -- ? ) -- n )
   8     ! Call quot until it returns false, return number of times
   9     ! it was true
  10     [ 0 ] dip '[ _ dip swap [ [ 1 + ] when ] keep ] loop ; inline
  11
  12 : count-flips ( perm -- flip# )
  13     '[
  14         _ dup first dup 1 =
  15         [ 2drop f ] [ head-slice reverse! drop t ] if
  16     ] count ; inline
  17
  18 : write-permutation ( perm -- )
  19     [ CHAR: 0 + write1 ] each nl ; inline
  20
  21 : fannkuch-step ( counter max-flips perm -- counter max-flips )
  22     pick 30 < [ [ 1 + ] [ ] [ dup write-permutation ] tri* ] when
  23     count-flips max ; inline
  24
  25 : fannkuch ( n -- )
  26     [
  27         [ 0 0 ] dip <iota> [ 1 + ] B{ } map-as
  28         [ fannkuch-step ] each-permutation nip
  29     ] keep
  30     "Pfannkuchen(" write pprint ") = " write . ;
  31
  32 : fannkuch-benchmark ( -- )
  33     9 fannkuch ;
  34
  35 MAIN: fannkuch-benchmark