Jordan-Pólya numbers: Difference between revisions
Added Perl
SqrtNegInf (talk | contribs) m (→{{header|Raku}}: simplify with 'splice') |
SqrtNegInf (talk | contribs) (Added Perl) |
||
Line 1,374:
3800-th : 7,213,895,789,838,336 = (4!)^8 (2!)^16
real 0m0,004s user 0m0,004s sys 0m0,000s</pre>
=={{header|Perl}}==
{{trans|Raku}}
{{libheader|ntheory}}
<syntaxhighlight lang="perl" line>
use strict;
use warnings;
use feature 'say';
use ntheory 'factorial';
use List::AllUtils <max firstidx>;
sub table { my $t = 10 * (my $c = 1 + length max @_); ( sprintf( ('%'.$c.'d')x@_, @_) ) =~ s/.{1,$t}\K/\n/gr }
sub Jordan_Polya {
my $limit = shift;
my($k,@JP) = (2);
push @JP, factorial $_ for 0..18;
while ($k < @JP) {
my $rk = $JP[$k];
for my $l (2 .. @JP) {
my $kl = $JP[$l] * $rk;
last if $kl > $limit;
LOOP: {
my $p = firstidx { $_ >= $kl } @JP;
if ($p < $#JP and $JP[$p] != $kl) { splice @JP, $p, 0, $kl }
elsif ($p == $#JP ) { push @JP, $kl }
$kl > $limit/$rk ? last LOOP : ($kl *= $rk)
}
}
$k++
}
shift @JP; return @JP
}
my @JP = Jordan_Polya 2**27;
say "First 50 Jordan-Pólya numbers:\n" . table @JP[0..49];
say 'The largest Jordan-Pólya number before 100 million: ' . $JP[-1 + firstidx { $_ > 1e8 } @JP];
</syntaxhighlight>
{{out}}
<pre>
First 50 Jordan-Pólya numbers:
1 2 4 6 8 12 16 24 32 36
48 64 72 96 120 128 144 192 216 240
256 288 384 432 480 512 576 720 768 864
960 1024 1152 1296 1440 1536 1728 1920 2048 2304
2592 2880 3072 3456 3840 4096 4320 4608 5040 5184
The largest Jordan-Pólya number before 100 million: 99532800
</pre>
=={{header|Phix}}==
| |||