Summarize and say sequence: Difference between revisions
Rename Perl 6 -> Raku, alphabetize, minor clean-up
m (→{{header|Factor}}: 10 swap ^ -> 10^) |
Thundergnat (talk | contribs) (Rename Perl 6 -> Raku, alphabetize, minor clean-up) |
||
Line 354:
19281716151413427110
19182716152413228110</pre>
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
Line 844 ⟶ 845:
</pre>
=={{header|Clojure}}==
Line 975 ⟶ 921:
(doseq [ds result]
(println (apply str ds))))</lang>
=={{header|CoffeeScript}}==
{{incomplete|CoffeeScript|This code only produces one of the seeds, not all of them.}}
This takes less than a second to run, even though the only real optimization is to exclude integers that don't have their digits descending.
<lang coffeescript>
sequence = (n) ->
cnts = {}
for c in n.toString()
d = parseInt(c)
incr cnts, d
seq = []
while true
s = ''
for i in [9..0]
s += "#{cnts[i]}#{i}" if cnts[i]
if s in seq
break
seq.push s
new_cnts = {}
for digit, cnt of cnts
incr new_cnts, cnt
incr new_cnts, digit
cnts = new_cnts
seq
incr = (h, k) ->
h[k] ?= 0
h[k] += 1
descending = (n) ->
return true if n < 10
tens = n / 10
return false if n % 10 > tens % 10
descending(tens)
max_len = 0
for i in [1..1000000]
if descending(i)
seq = sequence(i)
if seq.length > max_len
max_len = seq.length
max_seq = seq
max_i = i
console.log max_i, max_seq
</lang>
<pre> 9900 ["2920", "192210", "19222110", "19323110", "1923123110", "1923224110", "191413323110",
"191433125110", "19151423125110", "19251413226110", "1916151413325110", "1916251423127110", "1
91716151413326110", "191726151423128110", "19181716151413327110", "19182716151423129110",
"29181716151413328110", "19281716151423228110", "19281716151413427110", "19182716152413228110"]</pre>
=={{header|Common Lisp}}==
Line 2,915 ⟶ 2,916:
print "longest ($mlen): @mlist\n";
print join("\n", seq($_)), "\n\n" for @mlist;</lang>
=={{header|Phix}}==
Line 3,305 ⟶ 3,226:
19281716151413427110
19182716152413228110
</pre>
=={{header|Raku}}==
(formerly Perl 6)
{{Works with|rakudo|2018.03}}
<lang perl6>my @list;
my $longest = 0;
my %seen;
for 1 .. 1000000 -> $m {
next unless $m ~~ /0/; # seed must have a zero
my $j = join '', $m.comb.sort;
next if %seen{$j}:exists; # already tested a permutation
%seen{$j} = '';
my @seq = converging($m);
my %elems;
my $count;
for @seq[] -> $value { last if ++%elems{$value} == 2; $count++; };
if $longest == $count {
@list.push($m);
}
elsif $longest < $count {
$longest = $count;
@list = $m;
print "\b" x 20, "$count, $m"; # monitor progress
}
};
for @list -> $m {
say "\nSeed Value(s): ", my $seeds = ~permutations($m).unique.grep( { .substr(0,1) != 0 } );
my @seq = converging($m);
my %elems;
my $count;
for @seq[] -> $value { last if ++%elems{$value} == 2; $count++; };
say "\nIterations: ", $count;
say "\nSequence: (Only one shown per permutation group.)";
.say for |@seq[^$count], "\n";
}
sub converging ($seed) { return $seed, -> $l { join '', map { $_.value.elems~$_.key }, $l.comb.classify({$^b}).sort: {-$^c.key} } ... * }
sub permutations ($string, $sofar? = '' ) {
return $sofar unless $string.chars;
my @perms;
for ^$string.chars -> $idx {
my $this = $string.substr(0,$idx)~$string.substr($idx+1);
my $char = substr($string, $idx,1);
@perms.push( |permutations( $this, join '', $sofar, $char ) );
}
return @perms;
}</lang>
{{out}}
<pre>
Seed Value(s): 9009 9090 9900
Iterations: 21
Sequence: (Only one shown per permutation group.)
9009
2920
192210
19222110
19323110
1923123110
1923224110
191413323110
191433125110
19151423125110
19251413226110
1916151413325110
1916251423127110
191716151413326110
191726151423128110
19181716151413327110
19182716151423129110
29181716151413328110
19281716151423228110
19281716151413427110
19182716152413228110
</pre>
Line 3,553 ⟶ 3,555:
19281716151413427110
19182716152413228110</pre>
=={{header|Tcl}}==
<!-- The first version of this code had a neat trick with sorting the strings characters and using a counting regexp, but it was very slow -->
<lang tcl>proc nextterm n {
foreach c [split $n ""] {incr t($c)}
foreach c {9 8 7 6 5 4 3 2 1 0} {
if {[info exist t($c)]} {append r $t($c) $c}
}
return $r
}
# Local context of lambda term is just for speed
apply {limit {
# Build a digit cache; this adds quite a bit of speed
set done [lrepeat [set l2 [expr {$limit * 100}]] 0]
# Iterate over search space
set maxlen 0
set maxes {}
for {set i 0} {$i < $limit} {incr i} {
if {[lindex $done $i]} continue
# Compute the sequence length for this value (with help from cache)
set seq {}
for {set seed $i} {$seed ni $seq} {set seed [nextterm $seed]} {
if {$seed < $l2 && [lindex $done $seed]} {
set len [expr {[llength $seq] + [lindex $done $seed]}]
break
}
set len [llength [lappend seq $seed]]
}
# What are we going to do about it?
if {$len > $maxlen} {
set maxlen $len
set maxes [list $i]
} elseif {$len == $maxlen} {
lappend maxes $i
}
# Update the cache with what we have learned
foreach n $seq {
if {$n < $l2} {lset done $n $len}
incr len -1
}
}
# Output code
puts "max length: $maxlen"
foreach c $maxes {puts $c}
puts "Sample max-len sequence:"
set seq {}
# Rerun the sequence generator for printing; faster for large limits
for {set seed [lindex $c 0]} {$seed ni $seq} {set seed [nextterm $seed]} {
lappend seq $seed
puts "\t$seed"
}
}} 1000000</lang>
Output:
<pre>
max length: 21
9009
9090
9900
Sample max-len sequence:
9900
2920
192210
19222110
19323110
1923123110
1923224110
191413323110
191433125110
19151423125110
19251413226110
1916151413325110
1916251423127110
191716151413326110
191726151423128110
19181716151413327110
19182716151423129110
29181716151413328110
19281716151423228110
19281716151413427110
19182716152413228110
</pre>
=={{header|TXR}}==
Line 3,762 ⟶ 3,845:
19281716151413427110
19182716152413228110</pre>
=={{header|zkl}}==
| |||