Primes - allocate descendants to their ancestors: Difference between revisions

Added Perl example
(Added Perl example)
Line 1,023:
Total descendants 546986
</pre>
 
=={{header|Perl}}==
{{trans|Perl 6}}
<lang perl>use List::Util qw(sum uniq);
use ntheory qw(nth_prime);
 
my $max = 99;
my %tree;
 
sub allocate {
my($n, $i, $sum,, $prod) = @_;
$i //= 0; $sum //= 0; $prod //= 1;
 
for my $k (0..$max) {
next if $k < $i;
my $p = nth_prime($k+1);
if (($sum + $p) <= $max) {
allocate($n, $k, $sum + $p, $prod * $p);
} else {
last if $sum == $prod;
$tree{$sum}{descendants}{$prod} = 1;
$tree{$prod}{ancestor} = [uniq $sum, @{$tree{$sum}{ancestor}}] unless $prod > $max || $sum == 0;
last;
}
}
}
 
sub abbrev { # abbreviate long lists to first and last 5 elements
my(@d) = @_;
return @d if @d < 11;
@d[0 .. 4], '...', @d[-5 .. -1];
}
 
allocate($_) for 1 .. $max;
 
$total = 0;
map { for my $k (keys %{$tree{$_}{descendants}}) { $total += $tree{$_}{descendants}{$k} } } 1..$max;
 
for (1 .. 15, 46, $max) {
printf "%2d, %2d Ancestors: %-15s", $_, (scalar uniq @{$tree{$_}{ancestor}}),
'[' . join(' ',uniq @{$tree{$_}{ancestor}}) . ']';
my $dn = 0; my $dl = '';
if ($tree{$_}{descendants}) {
$dn = keys %{$tree{$_}{descendants}};
$dl = join ' ', abbrev(sort { $a <=> $b } keys %{$tree{$_}{descendants}});
}
printf "%5d Descendants: %s", $dn, "[$dl]\n";
}
print "Total descendants: $total\n";</lang>
{{out}}
<pre> 1, 0 Ancestors: [], 0 Descendants: []
2, 0 Ancestors: [], 0 Descendants: []
3, 0 Ancestors: [], 0 Descendants: []
4, 0 Ancestors: [], 0 Descendants: []
5, 0 Ancestors: [], 1 Descendants: [6]
6, 1 Ancestors: [5], 2 Descendants: [8 9]
7, 0 Ancestors: [], 2 Descendants: [10 12]
8, 2 Ancestors: [5 6], 3 Descendants: [15 16 18]
9, 2 Ancestors: [5 6], 4 Descendants: [14 20 24 27]
10, 1 Ancestors: [7], 5 Descendants: [21 25 30 32 36]
11, 0 Ancestors: [], 5 Descendants: [28 40 45 48 54]
12, 1 Ancestors: [7], 7 Descendants: [35 42 50 60 64 72 81]
13, 0 Ancestors: [], 8 Descendants: [22 56 63 75 80 90 96 108]
14, 3 Ancestors: [5 6 9], 10 Descendants: [33 49 70 84 100 120 128 135 144 162]
15, 3 Ancestors: [5 6 8], 12 Descendants: [26 44 105 112 125 ... 160 180 192 216 243]
46, 3 Ancestors: [7 10 25], 557 Descendants: [129 205 246 493 518 ... 14171760 15116544 15943230 17006112 19131876]
99, 1 Ancestors: [17], 38257 Descendants: [194 1869 2225 2670 2848 ... 3904305912313344 4117822641892980 4392344151352512 4941387170271576 5559060566555523]
 
Total descendants: 546986</pre>
 
=={{header|Perl 6}}==
2,392

edits