Summarize and say sequence: Difference between revisions

Add Factor
(Add Factor)
Line 1,803:
19281716151413427110
19182716152413228110
</pre>
 
=={{header|Factor}}==
Like the Eiffel example, this program saves time by considering only seed numbers whose digits are in increasing order (zeros are exempt). This ensures that extra permutations of a number are not searched, as they produce equivalent sequences (aside from the first element). For instance, &nbsp; <tt>21</tt> &nbsp; is the first number to be skipped because it's a permutation of &nbsp; <tt>12</tt>.
<lang factor>USING: assocs grouping io kernel math math.combinatorics
math.functions math.ranges math.statistics math.text.utils
prettyprint sequences sets ;
IN: rosetta-code.self-referential-sequence
 
: next-term ( seq -- seq ) histogram >alist concat ;
 
! Output the self-referential sequence, given a seed value.
: srs ( seq -- seq n )
V{ } clone [ 2dup member? ] [ 2dup push [ next-term ] dip ]
until nip dup length ;
 
: digit-before? ( m n -- ? ) dup zero? [ 2drop t ] [ <= ] if ;
 
! The numbers from 1 to n sans permutations.
: candidates ( n -- seq )
[1,b] [ 1 digit-groups reverse ] map
[ [ digit-before? ] monotonic? ] filter ;
 
: max-seed ( n -- seq ) candidates [ srs nip ] supremum-by ;
 
: max-seeds ( n -- seq )
max-seed <permutations> members [ first zero? ] reject ;
 
: digits>number ( seq -- n ) [ 10 swap ^ * ] map-index sum ;
 
: >numbers ( seq -- seq ) [ digits>number ] map ;
 
: main ( -- )
"Seed value(s): " write
1,000,000 max-seeds
[ [ reverse ] map >numbers . ]
[ first srs ] bi
"Iterations: " write .
"Sequence:" print >numbers . ;
 
MAIN: main</lang>
{{out}}
<pre>
Seed value(s): V{ 9009 9090 9900 }
Iterations: 21
Sequence:
V{
9009
2920
221910
22192110
19323110
1923123110
1923224110
191413323110
191433125110
19151423125110
19251413226110
1916151413325110
1916251423127110
191716151413326110
191726151423128110
19181716151413327110
19182716151423129110
29181716151413328110
19281716151423228110
19281716151413427110
19182716152413228110
}
</pre>
 
1,808

edits