Summarize and say sequence: Difference between revisions
Content added Content deleted
m (→{{header|Factor}}: 10 swap ^ -> 10^) |
Thundergnat (talk | contribs) (Rename Perl 6 -> Raku, alphabetize, minor clean-up) |
||
Line 354: | Line 354: | ||
19281716151413427110 |
19281716151413427110 |
||
19182716152413228110</pre> |
19182716152413228110</pre> |
||
=={{header|BBC BASIC}}== |
=={{header|BBC BASIC}}== |
||
{{works with|BBC BASIC for Windows}} |
{{works with|BBC BASIC for Windows}} |
||
Line 844: | Line 845: | ||
</pre> |
</pre> |
||
=={{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|Clojure}}== |
=={{header|Clojure}}== |
||
Line 975: | Line 921: | ||
(doseq [ds result] |
(doseq [ds result] |
||
(println (apply str ds))))</lang> |
(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}}== |
=={{header|Common Lisp}}== |
||
Line 2,915: | Line 2,916: | ||
print "longest ($mlen): @mlist\n"; |
print "longest ($mlen): @mlist\n"; |
||
print join("\n", seq($_)), "\n\n" for @mlist;</lang> |
print join("\n", seq($_)), "\n\n" for @mlist;</lang> |
||
=={{header|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> |
|||
=={{header|Phix}}== |
=={{header|Phix}}== |
||
Line 3,305: | Line 3,226: | ||
19281716151413427110 |
19281716151413427110 |
||
19182716152413228110 |
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> |
</pre> |
||
Line 3,553: | Line 3,555: | ||
19281716151413427110 |
19281716151413427110 |
||
19182716152413228110</pre> |
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}}== |
=={{header|TXR}}== |
||
Line 3,762: | Line 3,845: | ||
19281716151413427110 |
19281716151413427110 |
||
19182716152413228110</pre> |
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|zkl}}== |
=={{header|zkl}}== |