extra/rosetta-code/hamming/hamming.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors deques dlists fry kernel make math math.order ;
   4 IN: rosetta-code.hamming
   5
   6 ! http://rosettacode.org/wiki/Hamming_numbers#Factor
   7
   8 ! Hamming numbers are numbers of the form
   9 !    H = 2^i * 3^j * 5^k        where i, j, k >= 0
  10
  11 ! Hamming numbers are also known as ugly numbers and also
  12 ! 5-smooth numbers (numbers whose prime divisors are less or equal
  13 ! to 5).
  14
  15 ! Generate the sequence of Hamming numbers, in increasing order.
  16 ! In particular:
  17
  18 ! 1. Show the first twenty Hamming numbers.
  19 ! 2. Show the 1691st Hamming number (the last one below 231).
  20 ! 3. Show the one millionth Hamming number (if the language – or
  21 !    a convenient library – supports arbitrary-precision integers).
  22
  23 TUPLE: hamming-iterator 2s 3s 5s ;
  24
  25 : <hamming-iterator> ( -- hamming-iterator )
  26     hamming-iterator new
  27         1 1dlist >>2s
  28         1 1dlist >>3s
  29         1 1dlist >>5s ;
  30
  31 : enqueue ( n hamming-iterator -- )
  32     [ [ 2 * ] [ 2s>> ] bi* push-back ]
  33     [ [ 3 * ] [ 3s>> ] bi* push-back ]
  34     [ [ 5 * ] [ 5s>> ] bi* push-back ] 2tri ;
  35
  36 : next ( hamming-iterator -- n )
  37     dup [ 2s>> ] [ 3s>> ] [ 5s>> ] tri
  38     3dup [ peek-front ] tri@ min min
  39     [
  40         '[
  41             dup peek-front _ =
  42             [ pop-front* ] [ drop ] if
  43         ] tri@
  44     ] [ swap enqueue ] [ ] tri ;
  45
  46 : next-n ( hamming-iterator n -- seq )
  47     swap '[ _ [ _ next , ] times ] { } make ;
  48
  49 : nth-from-now ( hamming-iterator n -- m )
  50     1 - over '[ _ next drop ] times next ;