Jordan-Pólya numbers

Revision as of 14:55, 30 May 2023 by Boreal (talk | contribs) (Faster XPL0 example.)

Jordan-Pólya numbers (or J-P numbers for short) are the numbers that can be obtained by multiplying together one or more (not necessarily distinct) factorials.

Jordan-Pólya 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.
Example

480 is a J-P number because 480 = 2! x 2! x 5!.

Task

Find and show on this page the first 50 J-P numbers.

What is the largest J-P number less than 100 million?

Bonus

Find and show on this page the 800th, 1,800th, 2,800th and 3,800th J-P numbers and also show their decomposition into factorials in highest to lowest order.

Hint: These J-P numbers are all less than 2^53.

References


Wren

Library: Wren-set
Library: Wren-seq
Library: Wren-fmt

This uses the recursive PARI/Python algorithm in the OEIS entry.

import "./set" for Set
import "./seq" for Lst
import "./fmt" for Fmt

var JordanPolya = Fn.new { |lim, mx|
    if (lim < 2) return [1]
    var v = Set.new()
    v.add(1)
    var t = 1
    if (!mx) mx = lim
    for (k in 2..mx) {
        t = t * k
        if (t > lim) break
        for (rest in JordanPolya.call((lim/t).floor, t)) {
            v.add(t * rest)
        }
    }
    return v.toList.sort()
}

var factorials = List.filled(19, 1)

var cacheFactorials = Fn.new {
    var fact = 1
    for (i in 2..18) {
        fact = fact * i
        factorials[i] = fact
    }
}

var Decompose = Fn.new { |n, start|
    if (!start) start = 18
    if (start < 2) return []
    var m = n
    var f = []
    for (i in start..2) {
        while (m % factorials[i] == 0) {
            f.add(i)
            m =  m / factorials[i]
            if (m == 1) return f
        }
    }
    return Decompose.call(n, start-1)
}

cacheFactorials.call()
var v = JordanPolya.call(2.pow(53)-1, null)
System.print("First 50 Jordan–Pólya numbers:")
Fmt.tprint("$4d ", v[0..49], 10)

System.write("\nThe largest Jordan–Pólya number before 100 million: ")
for (i in 1...v.count) {
    if (v[i] > 1e8) {
        Fmt.print("$,d\n", v[i-1])
        break
    }
}

for (i in [800, 1800, 2800, 3800]) {
    Fmt.print("The $,r Jordan-Pólya number is : $,d", i, v[i-1])
    var g = Lst.individuals(Decompose.call(v[i-1], null))
    var s = g.map { |l|
        if (l[1] == 1) return "%(l[0])!"
        return Fmt.swrite("($d!)$S", l[0], l[1])
    }.join(" x ")
    Fmt.print("= $s\n", s)
}
Output:
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: 99,532,800

The 800th Jordan-Pólya number is : 18,345,885,696
= (4!)⁷ x (2!)²

The 1,800th Jordan-Pólya number is : 9,784,472,371,200
= (6!)² x (4!)² x (2!)¹⁵

The 2,800th Jordan-Pólya number is : 439,378,587,648,000
= 14! x 7!

The 3,800th Jordan-Pólya number is : 7,213,895,789,838,336
= (4!)⁸ x (2!)¹⁶

XPL0

Simple-minded brute force. 20 seconds on Pi4. No bonus.

int Factorials(1+12);

func IsJPNum(N0);
int  N0;
int  N, Limit, I, Q;
[Limit:= 7;
N:= N0;
loop    [I:= Limit;
        loop    [Q:= N / Factorials(I);
                if rem(0) = 0 then
                        [if Q = 1 then return true;
                        N:= Q;
                        ]
                else    I:= I-1;
                if I = 1 then 
                        [if Limit = 1 then return false;
                        Limit:= Limit-1;
                        N:= N0;
                        quit;
                        ]
                ];
        ];
];

int F, N, C, SN;
[F:= 1;
for N:= 1 to 12 do
        [F:= F*N;
        Factorials(N):= F;
        ];
Text(0, "First 50 Jordan-Polya numbers:^m^j");
Format(5, 0);
RlOut(0, 1.);           \handle odd number exception
C:= 1;  N:= 2;  
loop    [if IsJPNum(N) then
                [C:= C+1;
                if C <= 50 then
                        [RlOut(0, float(N));
                        if rem(C/10) = 0 then CrLf(0);
                        ];
                SN:= N;
                ];
        N:= N+2;
        if N >= 100_000_000 then quit;
        ];
Text(0, "^m^jThe largest Jordan-Polya number before 100 million: ");
IntOut(0, SN);  CrLf(0);
]
Output:
First 50 Jordan-Polya 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-Polya number before 100 million: 99532800