54 lines
1.6 KiB
Factor
54 lines
1.6 KiB
Factor
USING: combinators deques dlists formatting grouping io kernel
|
|
locals make math math.order math.parser math.ranges
|
|
math.text.english prettyprint sequences sorting strings ;
|
|
|
|
:: bfs ( from to num base -- )
|
|
DL{ } clone :> q
|
|
base 1 - :> ld
|
|
num q push-front
|
|
[ q deque-empty? ]
|
|
[
|
|
q pop-back :> step-num
|
|
step-num from to between? [ step-num , ] when
|
|
step-num zero? step-num to > or
|
|
[
|
|
step-num base mod :> last-digit
|
|
step-num base * last-digit 1 - + :> a
|
|
step-num base * last-digit 1 + + :> b
|
|
|
|
last-digit
|
|
{
|
|
{ 0 [ b q push-front ] }
|
|
{ ld [ a q push-front ] }
|
|
[ drop a q push-front b q push-front ]
|
|
} case
|
|
|
|
] unless
|
|
|
|
] until ;
|
|
|
|
:: esthetics ( from to base -- seq )
|
|
[ base <iota> [| num | from to num base bfs ] each ]
|
|
{ } make natural-sort ;
|
|
|
|
: .seq ( seq width -- )
|
|
group [ [ dup string? [ write ] [ pprint ] if bl ] each nl ]
|
|
each nl ;
|
|
|
|
:: show ( base -- )
|
|
base [ 4 * ] [ 6 * ] bi :> ( from to )
|
|
from to [ dup ordinal-suffix ] bi@ base
|
|
"%d%s through %d%s esthetic numbers in base %d\n" printf
|
|
from to 1 + 0 5000 ! enough for base 16
|
|
base esthetics subseq [ base >base ] map 17 .seq ;
|
|
|
|
2 16 [a,b] [ show ] each
|
|
|
|
"Base 10 numbers between 1,000 and 9,999:" print
|
|
1,000 9,999 10 esthetics 16 .seq
|
|
|
|
"Base 10 numbers between 100,000,000 and 130,000,000:" print
|
|
100,000,000 130,000,000 10 esthetics 9 .seq
|
|
|
|
"Count of base 10 esthetic numbers between zero and one quadrillion:"
|
|
print 0 1e15 10 esthetics length .
|