extra/benchmark/beust2/beust2.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: math math.ranges math.parser sequences kernel io locals ;
   4 IN: benchmark.beust2
   5
   6 ! http://crazybob.org/BeustSequence.java.html
   7
   8 :: (count-numbers) ( remaining first value used max listener: ( -- ) -- ? )
   9     10 first - iota [| i |
  10         [let* | digit [ i first + ]
  11                 mask [ digit 2^ ]
  12                 value' [ i value + ] |
  13             used mask bitand zero? [
  14                 value max > [ t ] [
  15                     remaining 1 <= [
  16                         listener call f
  17                     ] [
  18                         remaining 1 -
  19                         0
  20                         value' 10 *
  21                         used mask bitor
  22                         max
  23                         listener
  24                         (count-numbers)
  25                     ] if
  26                 ] if
  27             ] [ f ] if
  28         ]
  29     ] any? ; inline recursive
  30
  31 :: count-numbers ( max listener -- )
  32     10 iota [ 1 + 1 1 0 max listener (count-numbers) ] any? drop ;
  33     inline
  34
  35 :: beust ( -- )
  36     [let | i! [ 0 ] |
  37         5000000000 [ i 1 + i! ] count-numbers
  38         i number>string " unique numbers." append print
  39     ] ;
  40
  41 MAIN: beust