# Factor-perfect numbers

Factor-perfect numbers is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Consider the list of factors (divisors) of an integer, such as 12. The factors of 12 are [1, 2, 3, 4, 6, 12]. Consider all sorted sequences of the factors of n such that each succeeding number in such a sequence is a multiple of its predecessor. So, for 6, we have the factors (divisors) [1, 2, 3, 6]. The 3 unique lists of sequential multiples starting with 1 and ending with 6 that can be derived from these factors are [1, 6], [1, 2, 6], and [1, 3, 6].

Another way to see these sequences is as an set of all the ordered factorizations of a number taken so that their product is that number (excluding 1 from the sequence). So, for 6, we would have [6], [2, 3], and [3, 2]. In this description of the sequences, we are looking at the numbers needed to multiply by, in order to generate the next element in the sequences previously listed in our first definition of the sequence type, as we described it in the preceding paragraph, above.

For example, for the factorization of 6, if the first type of sequence is [1, 6], this is generated by [6] since 1 * 6 = 6. Similarly, the first type of sequence [1, 2, 6] is generated by the second type of sequence [2, 3] because 1 * 2 = 2 and 2 * 3 = 6. Similarly, [1, 3, 6] is generated by [3, 2] because 1 * 3 = 3 and 3 * 2 = 6.

If we count the number of such sorted sequences of multiples, or ordered factorizations, and using that count find all integers n for which the count of such sequences equals n, we have re-created the sequence of the "factor-perfect" numbers (OEIS 163272).

By some convention, on its OEIS page, the factor-perfect number sequence starts with 0 rather than 1. As might be expected with a sequence involving factorization and combinations, finding factor-perfect numbers becomes more demanding on CPU time as the numbers become large.

• Show all 48 ordered sequences for each of the two methods for n = 48, which is the first non-trivial factor-perfect number.

According to the paper listed below by P. Erdos, the number of these sequences is

${\displaystyle F(n) = \sum_{k} F(\frac{n}{a_k}) + 1 }$

where a is a list of the factors of n, including n, but excluding 1. F(n) is here the same as a function for calculating the number of different factorizations according to the second definition above except that F(1)=0 (where the number of factorizations of 1 must be 1 for it to be included in the sequence of factor-perfect numbers).

• Write a program to calculate and show the first 7 numbers of the factor-perfect numbers.

• Calculate and show more of the subsequent numbers in the sequence.

OEIS A163272 (Numbers k such that k = A074206(k), the number of ordered factorizations of k)
OEIS A074206 (Kalmár's [Kalmar's] problem: number of ordered factorizations of n.)
On the maximal order of numbers in the “factorisatio numerorum” problem (Klazar/Luca)
On Some Asymptotic Formulas in The Theory of The "Factorisatio Numerorum" (P. Erdos)


## J

Implementation:

factors=: {{/:~*/@>,{(^ i.)&.>/0 1+__ q:y}}
fp1=: {{ {{y#~0*/ .=~2|/\&>y}} y<@#"1~1,.~1,.#:i.2^_2+#y }}@factors
fp2=: 2 %~/\&.> fp1
Fi=: i.0
F=: {{
if. y>:#Fi do. Fi=: Fi{.~1+y end.
if. (1<y)*0=y{Fi do. Fi=: Fi y}~ 1++/F y%}.factors y end.
y{Fi
}}"0


Task examples (formed into 8 columns for easy viewing):

   _8,\fp1 48
┌────────────┬───────────┬───────────┬──────────────┬──────────────┬───────────┬─────────────┬──────────────┐
│1 48        │1 24 48    │1 16 48    │1 12 48       │1 12 24 48    │1 8 48     │1 8 24 48    │1 8 16 48     │
├────────────┼───────────┼───────────┼──────────────┼──────────────┼───────────┼─────────────┼──────────────┤
│1 6 48      │1 6 24 48  │1 6 12 48  │1 6 12 24 48  │1 4 48        │1 4 24 48  │1 4 16 48    │1 4 12 48     │
├────────────┼───────────┼───────────┼──────────────┼──────────────┼───────────┼─────────────┼──────────────┤
│1 4 12 24 48│1 4 8 48   │1 4 8 24 48│1 4 8 16 48   │1 3 48        │1 3 24 48  │1 3 12 48    │1 3 12 24 48  │
├────────────┼───────────┼───────────┼──────────────┼──────────────┼───────────┼─────────────┼──────────────┤
│1 3 6 48    │1 3 6 24 48│1 3 6 12 48│1 3 6 12 24 48│1 2 48        │1 2 24 48  │1 2 16 48    │1 2 12 48     │
├────────────┼───────────┼───────────┼──────────────┼──────────────┼───────────┼─────────────┼──────────────┤
│1 2 12 24 48│1 2 8 48   │1 2 8 24 48│1 2 8 16 48   │1 2 6 48      │1 2 6 24 48│1 2 6 12 48  │1 2 6 12 24 48│
├────────────┼───────────┼───────────┼──────────────┼──────────────┼───────────┼─────────────┼──────────────┤
│1 2 4 48    │1 2 4 24 48│1 2 4 16 48│1 2 4 12 48   │1 2 4 12 24 48│1 2 4 8 48 │1 2 4 8 24 48│1 2 4 8 16 48 │
└────────────┴───────────┴───────────┴──────────────┴──────────────┴───────────┴─────────────┴──────────────┘
_8,\fp2 48
┌───────┬───────┬───────┬─────────┬─────────┬───────┬─────────┬─────────┐
│48     │24 2   │16 3   │12 4     │12 2 2   │8 6    │8 3 2    │8 2 3    │
├───────┼───────┼───────┼─────────┼─────────┼───────┼─────────┼─────────┤
│6 8    │6 4 2  │6 2 4  │6 2 2 2  │4 12     │4 6 2  │4 4 3    │4 3 4    │
├───────┼───────┼───────┼─────────┼─────────┼───────┼─────────┼─────────┤
│4 3 2 2│4 2 6  │4 2 3 2│4 2 2 3  │3 16     │3 8 2  │3 4 4    │3 4 2 2  │
├───────┼───────┼───────┼─────────┼─────────┼───────┼─────────┼─────────┤
│3 2 8  │3 2 4 2│3 2 2 4│3 2 2 2 2│2 24     │2 12 2 │2 8 3    │2 6 4    │
├───────┼───────┼───────┼─────────┼─────────┼───────┼─────────┼─────────┤
│2 6 2 2│2 4 6  │2 4 3 2│2 4 2 3  │2 3 8    │2 3 4 2│2 3 2 4  │2 3 2 2 2│
├───────┼───────┼───────┼─────────┼─────────┼───────┼─────────┼─────────┤
│2 2 12 │2 2 6 2│2 2 4 3│2 2 3 4  │2 2 3 2 2│2 2 2 6│2 2 2 3 2│2 2 2 2 3│
└───────┴───────┴───────┴─────────┴─────────┴───────┴─────────┴─────────┘
(#~ (=*>.F)) i.30000
0 1 48 1280 2496 28672 29808


## jq

Works with: jq

Also works with gojq, the Go implementation of jq provided a definition of _nwise is provided.

# unordered
def proper_divisors:
. as $n | if$n > 1 then 1,
( range(2; 1 + (sqrt|floor)) as $i | if ($n % $i) == 0 then$i,
(($n /$i) | if . == $i then empty else . end) else empty end) else empty end; # Uses the first definition and recursion to generate the sequences. def moreMultiples($toSeq; $fromSeq): reduce$fromSeq[] as $i ({oneMores: []}; if ($i > $toSeq[-1]) and ($i % $toSeq[-1]) == 0 then .oneMores += [$toSeq + [$i]] else . end) | reduce range(0; .oneMores|length) as$i (.;
.oneMores += moreMultiples(.oneMores[$i];$fromSeq) )
| .oneMores ;

# Input: {cache, ...}
# Output: {cache, count, ... }
def erdosFactorCount($n): def properDivisors: proper_divisors | select(. != 1); # Since this is a recursive function, the local and global states # must be managed separately: (reduce ($n|properDivisors) as $d ([0, .]; # count, global ($n/$d) as$t
| ($t|tostring) as$ts
| if .[1].cache|has($ts) then . else .[1].cache[$ts] = (.[1]|erdosFactorCount($t).count) end | .[0] += (.[1].cache[$ts])
)) as $update | .count =$update[0] + 1
| .cache = ($update[1].cache) ; def task1: def lpad($len): tostring | ($len - length) as$l | (" " * $l)[:$l] + .;
def neatly:  _nwise(4) | map(tostring|lpad(20)) | join(" ");

moreMultiples([1]; [48|proper_divisors])
| sort
| map(. + [48]) + [[1, 48]]
| "\(length) sequences using first definition:", neatly,

(. as $listing | reduce range(0;$listing|length) as $i ([];$listing[$i] as$seq
| (if ($seq[-1] != 48) then$seq + [48] else $seq end) as$seq
| . + [[ range(1; $seq|length) as$i | ($seq[$i]/$seq[$i-1]) | floor ]] )
| "\n\(length) sequences using second definition:", neatly );

# Stream the values of A163272:
def A163272:
0,1,
({n:4}
| while(true;
.emit=null
| erdosFactorCount(.n) # update the cache
| if .count == .n then .emit =.n else . end
| .n += 4 )
| select(.emit).emit);

"",
"OEIS A163272:", limit(7; A163272)
Output:
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


## Julia

Revised to reflect a faster counting method (see second paper in the references).

using Primes
using Memoize

""" Return the factors of n, including 1, n """
function factors(n::T)::Vector{T} where T <: Integer
sort(vec(map(prod, Iterators.product((p.^(0:m) for (p, m) in eachfactor(n))...))))
end

""" Uses the first definition and recursion to generate the sequences """
function more_multiples(to_seq, from_seq)
onemores = [[to_seq; i] for i in from_seq if i > to_seq[end] && i % to_seq[end] == 0]
isempty(onemores) && return Int[]
return append!(onemores, mapreduce(seq -> more_multiples(seq, from_seq), append!, onemores))
end

""" See reference paper by Erdos, page 1 """
@memoize function kfactors(n)
a = factors(n)
return sum(kfactors(n ÷ d) for d in a[begin+1:end]) + 1
end

listing = sort!(push!(map(a -> push!(a, 48), more_multiples([1], factors(48)[begin+1:end-1])), [1, 48]))
println("48 sequences using first definition:")
for (i, seq) in enumerate(listing)
print(rpad(seq, 22), i % 4 == 0 ? "\n" : "")
end

println("\n48 sequences using second definition:")
for (i, seq) in enumerate(listing)
seq2 = [seq[j] ÷ seq[j - 1] for j in 2:length(seq)]
print(rpad(seq2, 20), i % 4 == 0 ? "\n" : "")
end

println("\nOEIS A163272: ")
for n in 0:2_400_000
if n == 0 || kfactors(n) == n
print(n, ",  ")
end
end

Output:
48 sequences using first definition:
[1, 2, 4, 8, 16, 48]  [1, 2, 4, 8, 24, 48]  [1, 2, 4, 8, 48]      [1, 2, 4, 12, 24, 48]
[1, 2, 4, 12, 48]     [1, 2, 4, 16, 48]     [1, 2, 4, 24, 48]     [1, 2, 4, 48]
[1, 2, 6, 12, 24, 48] [1, 2, 6, 12, 48]     [1, 2, 6, 24, 48]     [1, 2, 6, 48]
[1, 2, 8, 16, 48]     [1, 2, 8, 24, 48]     [1, 2, 8, 48]         [1, 2, 12, 24, 48]
[1, 2, 12, 48]        [1, 2, 16, 48]        [1, 2, 24, 48]        [1, 2, 48]
[1, 3, 6, 12, 24, 48] [1, 3, 6, 12, 48]     [1, 3, 6, 24, 48]     [1, 3, 6, 48]
[1, 3, 12, 24, 48]    [1, 3, 12, 48]        [1, 3, 24, 48]        [1, 3, 48]
[1, 4, 8, 16, 48]     [1, 4, 8, 24, 48]     [1, 4, 8, 48]         [1, 4, 12, 24, 48]
[1, 4, 12, 48]        [1, 4, 16, 48]        [1, 4, 24, 48]        [1, 4, 48]
[1, 6, 12, 24, 48]    [1, 6, 12, 48]        [1, 6, 24, 48]        [1, 6, 48]
[1, 8, 16, 48]        [1, 8, 24, 48]        [1, 8, 48]            [1, 12, 24, 48]
[1, 12, 48]           [1, 16, 48]           [1, 24, 48]           [1, 48]

48 sequences using second definition:
[2, 2, 2, 2, 3]     [2, 2, 2, 3, 2]     [2, 2, 2, 6]        [2, 2, 3, 2, 2]
[2, 2, 3, 4]        [2, 2, 4, 3]        [2, 2, 6, 2]        [2, 2, 12]
[2, 3, 2, 2, 2]     [2, 3, 2, 4]        [2, 3, 4, 2]        [2, 3, 8]
[2, 4, 2, 3]        [2, 4, 3, 2]        [2, 4, 6]           [2, 6, 2, 2]
[2, 6, 4]           [2, 8, 3]           [2, 12, 2]          [2, 24]
[3, 2, 2, 2, 2]     [3, 2, 2, 4]        [3, 2, 4, 2]        [3, 2, 8]
[3, 4, 2, 2]        [3, 4, 4]           [3, 8, 2]           [3, 16]
[4, 2, 2, 3]        [4, 2, 3, 2]        [4, 2, 6]           [4, 3, 2, 2]
[4, 3, 4]           [4, 4, 3]           [4, 6, 2]           [4, 12]
[6, 2, 2, 2]        [6, 2, 4]           [6, 4, 2]           [6, 8]
[8, 2, 3]           [8, 3, 2]           [8, 6]              [12, 2, 2]
[12, 4]             [16, 3]             [24, 2]             [48]

OEIS A163272:
0,  1,  48,  1280,  2496,  28672,  29808,  454656,  2342912,


## Phix

Library: Phix/online

You can run this online here (expect a blank screen for ~30s).

--
-- demo/rosetta/factor-perfect_numbers.exw
--
with javascript_semantics

function get_factor_set(integer x)
if x=1 then return {1} end if
sequence res = {}
for k=1 to x-1 do
if remainder(x,k)=0 then
for y in get_factor_set(k) do
res = append(res,y&x)
end for
end if
end for
res = sort(res)
return res
end function

function m(sequence s, integer f)
sequence res = {}
for x in s do
x = deep_copy(x)
if x[$]!=f then x &= f end if for i=length(x) to 2 by -1 do x[i] /= x[i-1] end for res = append(res,x[2..$])
end for
return res
end function

constant N = 48
sequence rN = get_factor_set(N)
function jbm(bool munge)
if munge then rN = m(rN,N) end if
return {length(rN),join_by(apply(rN,ppf),1,4," ",fmt:="%-16s")}
end function
ppOpt({pp_IntCh,false,pp_StrFmt,3})
printf(1,"%d sequences using first definition:\n%s\n",jbm(false))
printf(1,"%d sequences using second definition:\n%s\n",jbm(true))

integer efc_cache = new_dict()

function erdosFactorCount(integer n)
sequence divs = factors(n)
integer res = 1
for d in divs do
integer t = n/d, r, node = getd_index(t,efc_cache)
if node=NULL then
r = erdosFactorCount(t)
setd(t,r,efc_cache)
else
r = getd_by_index(node,efc_cache)
end if
res += r
end for
return res
end function

atom t = time(), t1 = t+1
integer n = 4
sequence res = {"0","1"}
while length(res)<iff(platform()=JS?8:9) do
if erdosFactorCount(n)=n then
res = append(res,sprintf("%d",n))
end if
n += 4
if time()>t1 then
progress("%d found, checking %d...\r",{length(res),n})
t1 = time()+1
end if
end while
progress("")
printf(1,"Found %d: %s (%s)\n",{length(res),join(res," "),elapsed(time()-t)})

wait_key()

Output:
48 sequences using first definition:
{1,2,4,8,16,48}  {1,2,4,8,24,48}  {1,2,4,8,48}     {1,2,4,12,24,48}
{1,2,4,12,48}    {1,2,4,16,48}    {1,2,4,24,48}    {1,2,4,48}
{1,2,6,12,24,48} {1,2,6,12,48}    {1,2,6,24,48}    {1,2,6,48}
{1,2,8,16,48}    {1,2,8,24,48}    {1,2,8,48}       {1,2,12,24,48}
{1,2,12,48}      {1,2,16,48}      {1,2,24,48}      {1,2,48}
{1,3,6,12,24,48} {1,3,6,12,48}    {1,3,6,24,48}    {1,3,6,48}
{1,3,12,24,48}   {1,3,12,48}      {1,3,24,48}      {1,3,48}
{1,4,8,16,48}    {1,4,8,24,48}    {1,4,8,48}       {1,4,12,24,48}
{1,4,12,48}      {1,4,16,48}      {1,4,24,48}      {1,4,48}
{1,6,12,24,48}   {1,6,12,48}      {1,6,24,48}      {1,6,48}
{1,8,16,48}      {1,8,24,48}      {1,8,48}         {1,12,24,48}
{1,12,48}        {1,16,48}        {1,24,48}        {1,48}

48 sequences using second definition:
{2,2,2,2,3}      {2,2,2,3,2}      {2,2,2,6}        {2,2,3,2,2}
{2,2,3,4}        {2,2,4,3}        {2,2,6,2}        {2,2,12}
{2,3,2,2,2}      {2,3,2,4}        {2,3,4,2}        {2,3,8}
{2,4,2,3}        {2,4,3,2}        {2,4,6}          {2,6,2,2}
{2,6,4}          {2,8,3}          {2,12,2}         {2,24}
{3,2,2,2,2}      {3,2,2,4}        {3,2,4,2}        {3,2,8}
{3,4,2,2}        {3,4,4}          {3,8,2}          {3,16}
{4,2,2,3}        {4,2,3,2}        {4,2,6}          {4,3,2,2}
{4,3,4}          {4,4,3}          {4,6,2}          {4,12}
{6,2,2,2}        {6,2,4}          {6,4,2}          {6,8}
{8,2,3}          {8,3,2}          {8,6}            {12,2,2}
{12,4}           {16,3}           {24,2}           {48}

Found 9: 0 1 48 1280 2496 28672 29808 454656 2342912 (1 minute and 9s)


Unfortunately it takes 4 minutes 13 seconds to find 9 under p2js, so I've limited that to 8 (as mentioned above, ~30s)

## Python

''' Rosetta Code task Factor-perfect_numbers '''

from functools import cache
from sympy import divisors

def more_multiples(to_seq, from_seq):
''' Uses the first definition and recursion to generate the sequences '''
onemores = [to_seq + [i]
for i in from_seq if i > to_seq[-1] and i % to_seq[-1] == 0]
if len(onemores) == 0:
return []
for i in range(len(onemores)):
for arr in more_multiples(onemores[i], from_seq):
onemores.append(arr)
return onemores

listing = [a + [48]
for a in sorted(more_multiples([1], divisors(48)[1:-1]))] + [[1, 48]]
print('48 sequences using first definition:')
for j, seq in enumerate(listing):
print(f'{str(seq):22}', end='\n' if (j + 1) % 4 == 0 else '')

# Derive second definition's sequences
print('\n48 sequences using second definition:')
for k, seq in enumerate(listing):
seq2 = [seq[i] // seq[i - 1] for i in range(1, len(seq))]
print(f'{str(seq2):20}', end='\n' if (k + 1) % 4 == 0 else '')

@cache
def erdos_factor_count(number):
''' 'Erdos method '''
return sum(erdos_factor_count(number // d) for d in divisors(number)[1:-1]) + 1

print("\nOEIS A163272:  ", end='')
for num in range(2_400_000):
if num == 0 or erdos_factor_count(num) == num:
print(num, end=',  ')

Output:
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,


## Raku

Translation of: Wren
# 20221029 Raku programming solution

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 { unless x % d { @l.push: d; my \y = x div d; @l.push: y if y != d } } @l } sub moreMultiples (@toSeq, @fromSeq) { my @oneMores = gather for @fromSeq -> \j { take @toSeq.clone.push(j) if j > @toSeq[*-1] && j %% @toSeq[*-1] } return [] unless @oneMores.Bool; for (0..^+@oneMores) { @oneMores.append: moreMultiples @oneMores[$_], @fromSeq
}
return @oneMores
}

sub erdosFactorCount (\n) {
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:"; for @listing.rotor(4) -> \line { line.map: { printf "%-20s",$_ } ; say() }

my @listing2 = gather for (0..^+@listing) -> \j {
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:";
for @listing2.rotor(4) -> \line { line.map: { printf "%-20s", $_ } ; say() } say "\nOEIS A163272:"; while (+@fpns < 7) { @fpns.push($n) if erdosFactorCount($n) ==$n; $n += 4 } say ~@fpns;  Output: 48 sequences using first definition: 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 1 48 48 sequences using second definition: 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 48 OEIS A163272: 0 1 48 1280 2496 28672 29808 ## Wren Translation of: Python Library: Wren-math Library: Wren-fmt Timings are about: 0.19 secs for 7, 8.5 secs for 8 and 97 secs for 9 factor-perfect numbers. import "./math" for Int, Nums import "./fmt" for Fmt // Uses the first definition and recursion to generate the sequences. var moreMultiples moreMultiples = Fn.new { |toSeq, fromSeq| var oneMores = [] for (i in fromSeq) { if (i > toSeq[-1] && i%toSeq[-1] == 0) oneMores.add(toSeq + [i]) } if (oneMores.isEmpty) return [] for (i in 0...oneMores.count) { oneMores.addAll(moreMultiples.call(oneMores[i], fromSeq)) } return oneMores } var cache = {} var erdosFactorCount erdosFactorCount = Fn.new { |n| var divs = Int.properDivisors(n) divs.removeAt(0) var sum = 0 for (d in divs) { var t = (n/d).floor if (!cache.containsKey(t)) cache[t] = erdosFactorCount.call(t) sum = sum + cache[t] } return sum + 1 } var listing = moreMultiples.call([1], Int.properDivisors(48)) listing.sort { |l1, l2| var c1 = l1.count var c2 = l2.count for (i in 1...c1.min(c2)) { if (l1[i] < l2[i]) return true if (l1[i] > l2[i]) return false } if (c1 < c2) return true return false } listing.each { |l| l.add(48) } listing.add([1, 48]) System.print("%(listing.count) sequences using first definition:") Fmt.tprint("$-21n", listing, 4)

System.print("\n%(listing.count) sequences using second definition:")
var listing2 = []
for (i in 0...listing.count) {
var seq = listing[i]
var seq2 = (1...seq.count).map { |i| (seq[i]/seq[i-1]).floor }.toList
}
Fmt.tprint("\$-17n", listing2, 4)

System.print("\nOEIS A163272:")
var n = 4
var fpns = [0, 1]
while (fpns.count < 9) {
n = n + 4
}
System.print(fpns)

Output:
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]
`