Arithmetic numbers: Difference between revisions

=={{header|Perl}}==

{{trans|Raku}}

{{libheader|ntheory}}

<lang perl>use strict;

use warnings;

use feature 'say';

use List::Util <max sum>;

use ntheory <is_prime divisors>;

use Lingua::EN::Numbers qw(num2en num2en_ordinal);

sub comma { reverse ((reverse shift) =~ s/(.{3})/$1,/gr) =~ s/^,//r }

sub table { my $t = 10 * (my $c = 1 + length max @_); ( sprintf( ('%'.$c.'d')x@_, @_) ) =~ s/.{1,$t}\K/\n/gr }

my @A = 0;

for my $n (1..2E6) {

my @div = divisors $n;

push @A, $n if 0 == sum(@div) % @div;

}

say "The first @{[num2en 100]} arithmetic numbers:";

say table @A[1..100];

for my $x (1E3, 1E4, 1E5, 1E6) {

say "\nThe @{[num2en_ordinal $x]}: " . comma($A[$x]) .

"\nComposite arithmetic numbers ≤ @{[comma $A[$x]]}: " . comma -1 + grep { not is_prime($_) } @A[1..$x];

}</lang>

{{out}}

<pre>The first one hundred arithmetic numbers:

1 3 5 6 7 11 13 14 15 17

19 20 21 22 23 27 29 30 31 33

35 37 38 39 41 42 43 44 45 46

47 49 51 53 54 55 56 57 59 60

61 62 65 66 67 68 69 70 71 73

77 78 79 83 85 86 87 89 91 92

93 94 95 96 97 99 101 102 103 105

107 109 110 111 113 114 115 116 118 119

123 125 126 127 129 131 132 133 134 135

137 138 139 140 141 142 143 145 147 149

The one thousandth: 1,361

Composite arithmetic numbers ≤ 1,361: 782

The ten thousandth: 12,953

Composite arithmetic numbers ≤ 12,953: 8,458

The one hundred thousandth: 125,587

Composite arithmetic numbers ≤ 125,587: 88,219

The one millionth: 1,228,663

Composite arithmetic numbers ≤ 1,228,663: 905,043</pre>