Factor-perfect numbers: Difference between revisions

Added Sidef
(Added Sidef)
 
(4 intermediate revisions by 3 users not shown)
Line 283:
0, 1, 48, 1280, 2496, 28672, 29808, 454656, 2342912,
</pre>
 
=={{header|Nim}}==
{{trans|Python}}
<syntaxhighlight lang="Nim">import std/[algorithm, strutils, sugar, tables]
 
func moreMultiples(toSeq, fromSeq: seq[int]): seq[seq[int]] =
## Uses the first definition and recursion to generate the sequences.
result = collect:
for i in fromSeq:
if i > toSeq[^1] and i mod toSeq[^1] == 0:
toSeq & i
 
for i in 0..result.high:
for arr in moreMultiples(result[i], fromSeq):
result.add arr
 
func divisors(n: int): seq[int] =
## Return the list of divisors of "n".
var d = 1
while d * d <= n:
if n mod d == 0:
let q = n div d
result.add d
if q != d:
result.add q
inc d
result.sort()
 
func cmp(x, y: seq[int]): int =
## Compare two sequences.
for i in 0..<min(x.len, y.len):
result = cmp(x[i], y[i])
if result != 0: return
result = cmp(x.len, y.len)
 
let listing = collect(
for a in sorted(moreMultiples(@[1], divisors(48)[1..^2]), cmp):
a & 48) & @[@[1, 48]]
 
echo "48 sequences using first definition:"
for i, s in listing:
let item = '[' & s.join(", ") & ']'
stdout.write alignLeft(item, 22)
stdout.write if i mod 4 == 3: '\n' else: ' '
 
# Derive second definition's sequences
echo "\n48 sequences using second definition:"
 
for i, s1 in listing:
let s2 = collect:
for j in 1..s1.high:
s1[j] div s1[j - 1]
let item = '[' & s2.join(", ") & ']'
stdout.write alignLeft(item, 20)
stdout.write if i mod 4 == 3: '\n' else: ' '
 
var cache: Table[int, int]
 
proc erdosFactorCount(n: int): int =
## Erdos method.
if n in cache: return cache[n]
let ds = divisors(n)
if ds.len >= 2:
for d in ds[1..^2]:
result += erdosFactorCount(n div d)
inc result
cache[n] = result
 
stdout.write "\nOEIS A163272: "
let s = collect:
for num in 0..<2_400_000:
if num == 0 or erdosFactorCount(num) == num:
num
echo s.join(", ")
</syntaxhighlight>
 
{{out}}
<pre>48 sequences using first definition:
[1, 2, 48] [1, 2, 4, 48] [1, 2, 4, 8, 48] [1, 2, 4, 8, 16, 48]
[1, 2, 4, 8, 24, 48] [1, 2, 4, 12, 48] [1, 2, 4, 12, 24, 48] [1, 2, 4, 16, 48]
[1, 2, 4, 24, 48] [1, 2, 6, 48] [1, 2, 6, 12, 48] [1, 2, 6, 12, 24, 48]
[1, 2, 6, 24, 48] [1, 2, 8, 48] [1, 2, 8, 16, 48] [1, 2, 8, 24, 48]
[1, 2, 12, 48] [1, 2, 12, 24, 48] [1, 2, 16, 48] [1, 2, 24, 48]
[1, 3, 48] [1, 3, 6, 48] [1, 3, 6, 12, 48] [1, 3, 6, 12, 24, 48]
[1, 3, 6, 24, 48] [1, 3, 12, 48] [1, 3, 12, 24, 48] [1, 3, 24, 48]
[1, 4, 48] [1, 4, 8, 48] [1, 4, 8, 16, 48] [1, 4, 8, 24, 48]
[1, 4, 12, 48] [1, 4, 12, 24, 48] [1, 4, 16, 48] [1, 4, 24, 48]
[1, 6, 48] [1, 6, 12, 48] [1, 6, 12, 24, 48] [1, 6, 24, 48]
[1, 8, 48] [1, 8, 16, 48] [1, 8, 24, 48] [1, 12, 48]
[1, 12, 24, 48] [1, 16, 48] [1, 24, 48] [1, 48]
 
48 sequences using second definition:
[2, 24] [2, 2, 12] [2, 2, 2, 6] [2, 2, 2, 2, 3]
[2, 2, 2, 3, 2] [2, 2, 3, 4] [2, 2, 3, 2, 2] [2, 2, 4, 3]
[2, 2, 6, 2] [2, 3, 8] [2, 3, 2, 4] [2, 3, 2, 2, 2]
[2, 3, 4, 2] [2, 4, 6] [2, 4, 2, 3] [2, 4, 3, 2]
[2, 6, 4] [2, 6, 2, 2] [2, 8, 3] [2, 12, 2]
[3, 16] [3, 2, 8] [3, 2, 2, 4] [3, 2, 2, 2, 2]
[3, 2, 4, 2] [3, 4, 4] [3, 4, 2, 2] [3, 8, 2]
[4, 12] [4, 2, 6] [4, 2, 2, 3] [4, 2, 3, 2]
[4, 3, 4] [4, 3, 2, 2] [4, 4, 3] [4, 6, 2]
[6, 8] [6, 2, 4] [6, 2, 2, 2] [6, 4, 2]
[8, 6] [8, 2, 3] [8, 3, 2] [12, 4]
[12, 2, 2] [16, 3] [24, 2] [48]
 
OEIS A163272: 0, 1, 48, 1280, 2496, 28672, 29808, 454656, 2342912
</pre>
 
=={{header|Perl}}==
{{trans|Raku}}
<syntaxhighlight lang="perl" line>use v5.36;
 
sub table (@V) { my $t = 3 * (my $w = 2 + 20); ( sprintf( ('%-'.$w.'s')x@V, @V) ) =~ s/.{1,$t}\K/\n/gr }
 
sub proper_divisors ($x) {
my @l;
@l = 1 if $x > 1;
for my $d (2 .. int sqrt $x) {
if (0 == $x % $d) { push @l, $d; my $y = int($x/$d); push @l, $y if $y != $d }
}
@l
}
 
sub erdosFactorCount ($n) {
my @foo = proper_divisors($n); shift @foo;
state %cache;
my ($sum,@divs) = (0, @foo); #(proper_divisors $n)[1..*]);
for my $d (@divs) {
my $t = int($n/$d);
$cache{$t} = erdosFactorCount($t) unless $cache{$t};
$sum += $cache{$t}
}
++$sum
}
 
sub moreMultiples ($to, $from) {
my @oneMores;
for my $j (@$from) {
push @oneMores, [@$to, $j] if $j > $$to[-1] && 0 == $j % $$to[-1]
}
return unless @oneMores;
for (0 .. $#oneMores) {
push @oneMores, moreMultiples($oneMores[$_], $from);
}
@oneMores
}
 
my @listing = [1];
push @listing, moreMultiples [1], [proper_divisors(48)];
map { push @$_, 48 } @listing;
 
my @lists; map { push @lists, join ' ', @$_ } @listing;
say @listing . " sequences using first definition:\n" . table(@lists);
 
my @listing2;
for my $j (0.. $#listing) {
my @seq = @{$listing[$j]};
push @seq, 48 if $seq[-1] != 48;
push @listing2, join ' ', map { int $seq[$_] / $seq[$_-1] } 1 .. $#seq;
}
 
say @listing2 . " sequences using second definition:\n" . table(@listing2);
 
my($n,@fpns) = (4, 0,1);
while ($#fpns < 6) { push(@fpns, $n) if erdosFactorCount($n) == $n; $n += 4 }
say "OEIS A163272: @fpns";</syntaxhighlight>
{{out}}
<pre>48 sequences using first definition:
1 48 1 2 48 1 24 48
1 3 48 1 16 48 1 4 48
1 12 48 1 6 48 1 8 48
1 2 24 48 1 2 16 48 1 2 4 48
1 2 12 48 1 2 6 48 1 2 8 48
1 2 4 24 48 1 2 4 16 48 1 2 4 12 48
1 2 4 8 48 1 2 4 12 24 48 1 2 4 8 24 48
1 2 4 8 16 48 1 2 12 24 48 1 2 6 24 48
1 2 6 12 48 1 2 6 12 24 48 1 2 8 24 48
1 2 8 16 48 1 3 24 48 1 3 12 48
1 3 6 48 1 3 12 24 48 1 3 6 24 48
1 3 6 12 48 1 3 6 12 24 48 1 4 24 48
1 4 16 48 1 4 12 48 1 4 8 48
1 4 12 24 48 1 4 8 24 48 1 4 8 16 48
1 12 24 48 1 6 24 48 1 6 12 48
1 6 12 24 48 1 8 24 48 1 8 16 48
 
48 sequences using second definition:
48 2 24 24 2
3 16 16 3 4 12
12 4 6 8 8 6
2 12 2 2 8 3 2 2 12
2 6 4 2 3 8 2 4 6
2 2 6 2 2 2 4 3 2 2 3 4
2 2 2 6 2 2 3 2 2 2 2 2 3 2
2 2 2 2 3 2 6 2 2 2 3 4 2
2 3 2 4 2 3 2 2 2 2 4 3 2
2 4 2 3 3 8 2 3 4 4
3 2 8 3 4 2 2 3 2 4 2
3 2 2 4 3 2 2 2 2 4 6 2
4 4 3 4 3 4 4 2 6
4 3 2 2 4 2 3 2 4 2 2 3
12 2 2 6 4 2 6 2 4
6 2 2 2 8 3 2 8 2 3
 
OEIS A163272: 0 1 48 1280 2496 28672 29808</pre>
 
=={{header|Phix}}==
Line 480 ⟶ 684:
<syntaxhighlight lang="raku" line># 20221029 Raku programming solution
 
sub propdiv (\x) {
my ($n,@fpns,%cache) = 4, 0,1;
 
sub propdiv (\x) { # https://rosettacode.org/wiki/Proper_divisors#Raku
my @l = 1 if x > 1;
for (2 .. x.sqrt.floor) -> \d {
Line 492 ⟶ 694:
sub moreMultiples (@toSeq, @fromSeq) {
my @oneMores = gather for @fromSeq -> \j {
take @toSeq.clone.push(j) if j > @toSeq[*-1] &&and j %% @toSeq[*-1]
}
return []() unless @oneMores.Bool;
for (0..^+@oneMores) {
@oneMores.append: moreMultiples @oneMores[$_], @fromSeq
}
return @oneMores
}
 
sub erdosFactorCount (\n) {
state %cache;
my ($sum,@divs) = 0, |(propdiv n)[1..*];
my ($sum,@divs) = 0, |(propdiv n)[1..*];
for @divs -> \d {
unless %cache{my \t = n div d}:exists { %cache{t} = erdosFactorCount(t) }
$sum += %cache{t}
}
return ++$sum + 1
}
 
my @listing = moreMultiples [1], propdiv(48);
#`[[[[[ sub custom (\l1,\l2) {
for l1 Z l2 -> [\v1,\v2] { return True if v1 < v2; return False if v1 > v2 }
return +l1 < +l2 ?? True !! False
}
#given @listing { $_ .= sort: &custom; $_.map: *.push: 48; $_.push: [1,48] }
#given @listing { $_ .= sort: {$^b cmp $^a};$_.map: *.push: 48;$_.push: [1,48] }
]]]]]
given @listing { $_.map: *.push: 48; $_.push: [1,48] }
say @listing.elems," sequences using first definition:";
Line 525 ⟶ 721:
my @seq = |@listing[j];
@seq.append: 48 if @seq[*-1] != 48;
take (1..^+@seq).map: { @seq[$_] div @seq[$_-1] }
}
say "\n{@listing2.elems} sequences using second definition:";
Line 531 ⟶ 727:
 
say "\nOEIS A163272:";
my ($n,@fpns) = 4, 0,1;
while (+@fpns < 7) { @fpns.push($n) if erdosFactorCount($n) == $n; $n += 4 }
while (@fpns < 7) { @fpns.push($n) if erdosFactorCount($n) == $n; $n += 4 }
say ~@fpns;</syntaxhighlight>
{{out}}
Line 564 ⟶ 761:
OEIS A163272:
0 1 48 1280 2496 28672 29808</pre>
 
=={{header|Sidef}}==
{{trans|Perl}}
<syntaxhighlight lang="ruby">func erdosFactorCount (n) is cached {
 
var sum = 1
var divs = proper_divisors(n).slice(1)
 
divs.each {|d|
sum += __FUNC__(idiv(n,d))
}
 
return sum
}
 
func moreMultiples (to, from) {
var oneMores = []
from.each {|j|
if (j > to.tail && to.tail.divides(j)) {
oneMores << [to..., j]
}
}
for k in (oneMores.range) {
oneMores << __FUNC__(oneMores[k], from)...
}
return oneMores
}
 
var listing = [[1]]
listing << moreMultiples([1], proper_divisors(48))...
listing.each {|a| a << 48 }
 
say "#{listing.len} sequences using first definition:"
listing.slices(3).each { .map { .join(' ') }.map{ '%-20s' % _ }.join.say }
 
var listing2 = gather {
for j in (^listing.len) {
var seq = listing[j]
take(1..seq.end -> map {|j| seq[j] / seq[j-1] })
}
}
 
say "\n#{listing2.len} sequences using second definition:"
listing2.slices(3).each { .map { .join(' ') }.map{ '%-20s' % _ }.join.say }
 
print "\nOEIS A163272: "
say [0, 1, (1..Inf -> lazy.map {|n| 4*n }.grep{|n| erdosFactorCount(n) == n }.first(5))...]</syntaxhighlight>
 
{{out}}
<pre>
48 sequences using first definition:
1 48 1 2 48 1 3 48
1 4 48 1 6 48 1 8 48
1 12 48 1 16 48 1 24 48
1 2 4 48 1 2 6 48 1 2 8 48
1 2 12 48 1 2 16 48 1 2 24 48
1 2 4 8 48 1 2 4 12 48 1 2 4 16 48
1 2 4 24 48 1 2 4 8 16 48 1 2 4 8 24 48
1 2 4 12 24 48 1 2 6 12 48 1 2 6 24 48
1 2 6 12 24 48 1 2 8 16 48 1 2 8 24 48
1 2 12 24 48 1 3 6 48 1 3 12 48
1 3 24 48 1 3 6 12 48 1 3 6 24 48
1 3 6 12 24 48 1 3 12 24 48 1 4 8 48
1 4 12 48 1 4 16 48 1 4 24 48
1 4 8 16 48 1 4 8 24 48 1 4 12 24 48
1 6 12 48 1 6 24 48 1 6 12 24 48
1 8 16 48 1 8 24 48 1 12 24 48
 
48 sequences using second definition:
48 2 24 3 16
4 12 6 8 8 6
12 4 16 3 24 2
2 2 12 2 3 8 2 4 6
2 6 4 2 8 3 2 12 2
2 2 2 6 2 2 3 4 2 2 4 3
2 2 6 2 2 2 2 2 3 2 2 2 3 2
2 2 3 2 2 2 3 2 4 2 3 4 2
2 3 2 2 2 2 4 2 3 2 4 3 2
2 6 2 2 3 2 8 3 4 4
3 8 2 3 2 2 4 3 2 4 2
3 2 2 2 2 3 4 2 2 4 2 6
4 3 4 4 4 3 4 6 2
4 2 2 3 4 2 3 2 4 3 2 2
6 2 4 6 4 2 6 2 2 2
8 2 3 8 3 2 12 2 2
 
OEIS A163272: [0, 1, 48, 1280, 2496, 28672, 29808]
</pre>
 
=={{header|Wren}}==
Line 570 ⟶ 855:
{{libheader|Wren-fmt}}
Timings are about: 0.19 secs for 7, 8.5 secs for 8 and 97 secs for 9 factor-perfect numbers.
<syntaxhighlight lang="ecmascriptwren">import "./math" for Int, Nums
import "./fmt" for Fmt
 
2,747

edits