Jordan-Pólya numbers: Difference between revisions
(Faster XPL0 example.) |
|||
Line 20: | Line 20: | ||
* OEIS sequence [[oeis:A001013|A001013: Jordan-Pólya numbers]] |
* OEIS sequence [[oeis:A001013|A001013: Jordan-Pólya numbers]] |
||
<br> |
<br> |
||
=={{header|jq}}== |
|||
{{works with|jq}} |
|||
'''Also works with gojq, the Go implementation of jq''' |
|||
'''Adapted from [[#Wren|Wren]]''' |
|||
<syntaxhighlight lang="jq"> |
|||
### Generic functions |
|||
# For gojq |
|||
def _nwise($n): |
|||
def n: if length <= $n then . else .[0:$n] , (.[$n:] | n) end; |
|||
n; |
|||
def lpad($len): tostring | ($len - length) as $l | (" " * $l) + .; |
|||
# tabular print |
|||
def tprint(columns; wide): |
|||
reduce _nwise(columns) as $row (""; |
|||
. + ($row|map(lpad(wide)) | join(" ")) + "\n" ); |
|||
# Input: an array |
|||
# Output: a stream of pairs [$x, $frequency] |
|||
# A two-level dictionary is used: .[type][tostring] |
|||
def frequencies: |
|||
if length == 0 then empty |
|||
else . as $in |
|||
| reduce range(0; length) as $i ({}; |
|||
$in[$i] as $x |
|||
| .[$x|type][$x|tostring] as $pair |
|||
| if $pair |
|||
then .[$x|type][$x|tostring] |= (.[1] += 1) |
|||
else .[$x|type][$x|tostring] = [$x, 1] |
|||
end ) |
|||
| .[][] |
|||
end ; |
|||
# Output: the items in the stream up to but excluding the first for which cond is truthy |
|||
def emit_until(cond; stream): label $out | stream | if cond then break $out else . end; |
|||
### Jordan-Pólya numbers |
|||
# input: {factorial} |
|||
# output: an array |
|||
def JordanPolya($lim; $mx): |
|||
if $lim < 2 then [1] |
|||
else . + {v: [1], t: 1, k: 2} |
|||
| .mx = ($mx // $lim) |
|||
| until(.k > .mx or .t > $lim; |
|||
.t *= .k |
|||
| if .t <= $lim |
|||
then reduce JordanPolya(($lim/.t)|floor; .t)[] as $rest (.; |
|||
.v += [.t * $rest] ) |
|||
| .k += 1 |
|||
else . |
|||
end) |
|||
| .v |
|||
| unique |
|||
end; |
|||
# Cache m! for m <= $n |
|||
def cacheFactorials($n): |
|||
{fact: 1, factorial: [1]} |
|||
| reduce range(1; $n + 1) as $i (.; |
|||
.fact *= $i |
|||
| .factorial[$i] = .fact ); |
|||
# input: {factorial} |
|||
def Decompose($n; $start): |
|||
if $start and $start < 2 then [] |
|||
else |
|||
{ factorial, |
|||
start: ($start // 18), |
|||
m: $n, |
|||
f: [] } |
|||
| label $out |
|||
| foreach range(.start; 1; -1) as $i (.; |
|||
.i = $i |
|||
| .emit = null |
|||
| until (.emit or (.m % .factorial[$i] != 0); |
|||
.f += [$i] |
|||
| .m = (.m / .factorial[$i]) |
|||
| if .m == 1 then .emit = .f else . end) |
|||
| if .emit then ., break $out else . end) |
|||
| if .emit then .emit |
|||
elif .i == 2 then Decompose($n; .start-1) |
|||
else empty |
|||
end |
|||
end; |
|||
# Input: {factorial} |
|||
# $v should be an array of J-P numbers |
|||
def synopsis($v): |
|||
(100, 800, 1800, 2800, 3800) as $i |
|||
| if $v[$i-1] == null |
|||
then "\nThe \($i)th Jordan-Pólya number was not found." | error |
|||
else "\nThe \($i)th Jordan-Pólya number is \($v[$i-1] )", |
|||
([Decompose($v[$i-1]; null) | frequencies] |
|||
| map( if (.[1] == 1) then "\(.[0])!" else "(\(.[0])!)^\(.[1])" end) |
|||
| " i.e. " + join(" * ") ) |
|||
end ; |
|||
def task: |
|||
cacheFactorials(18) |
|||
| JordanPolya(pow(2;53)-1; null) as $v |
|||
| "\($v|length) Jordan–Pólya numbers have been found. The first 50 are:", |
|||
( $v[:50] | tprint(10; 4)), |
|||
"\nThe largest Jordan–Pólya number before 100 million: " + |
|||
"\(if $v[-1] > 1e8 then last(emit_until(. >= 1e8; $v[])) else "not found" end)", |
|||
synopsis($v) ; |
|||
task |
|||
</syntaxhighlight> |
|||
{{output}} |
|||
gojq and jq produce the same results except that gojq produces the factorizations in a different order. |
|||
The output shown here corresponds to the invocation: jq -nr -f jordan-polya-numbers.jq |
|||
<pre> |
|||
3887 Jordan–Pólya numbers have been found. The first 50 are: |
|||
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: 99532800 |
|||
The 100th Jordan-Pólya number is 92160 |
|||
i.e. 6! * (2!)^7 |
|||
The 800th Jordan-Pólya number is 18345885696 |
|||
i.e. (4!)^7 * (2!)^2 |
|||
The 1800th Jordan-Pólya number is 9784472371200 |
|||
i.e. (6!)^2 * (4!)^2 * (2!)^15 |
|||
The 2800th Jordan-Pólya number is 439378587648000 |
|||
i.e. 14! * 7! |
|||
The 3800th Jordan-Pólya number is 7213895789838336 |
|||
i.e. (4!)^8 * (2!)^16 |
|||
</pre> |
|||
=={{header|Wren}}== |
=={{header|Wren}}== |
||
{{libheader|Wren-set}} |
{{libheader|Wren-set}} |
Revision as of 08:42, 31 May 2023
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.
- 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
- Wikipedia article : Jordan-Pólya number
- OEIS sequence A001013: Jordan-Pólya numbers
jq
Also works with gojq, the Go implementation of jq
Adapted from Wren
### Generic functions
# For gojq
def _nwise($n):
def n: if length <= $n then . else .[0:$n] , (.[$n:] | n) end;
n;
def lpad($len): tostring | ($len - length) as $l | (" " * $l) + .;
# tabular print
def tprint(columns; wide):
reduce _nwise(columns) as $row ("";
. + ($row|map(lpad(wide)) | join(" ")) + "\n" );
# Input: an array
# Output: a stream of pairs [$x, $frequency]
# A two-level dictionary is used: .[type][tostring]
def frequencies:
if length == 0 then empty
else . as $in
| reduce range(0; length) as $i ({};
$in[$i] as $x
| .[$x|type][$x|tostring] as $pair
| if $pair
then .[$x|type][$x|tostring] |= (.[1] += 1)
else .[$x|type][$x|tostring] = [$x, 1]
end )
| .[][]
end ;
# Output: the items in the stream up to but excluding the first for which cond is truthy
def emit_until(cond; stream): label $out | stream | if cond then break $out else . end;
### Jordan-Pólya numbers
# input: {factorial}
# output: an array
def JordanPolya($lim; $mx):
if $lim < 2 then [1]
else . + {v: [1], t: 1, k: 2}
| .mx = ($mx // $lim)
| until(.k > .mx or .t > $lim;
.t *= .k
| if .t <= $lim
then reduce JordanPolya(($lim/.t)|floor; .t)[] as $rest (.;
.v += [.t * $rest] )
| .k += 1
else .
end)
| .v
| unique
end;
# Cache m! for m <= $n
def cacheFactorials($n):
{fact: 1, factorial: [1]}
| reduce range(1; $n + 1) as $i (.;
.fact *= $i
| .factorial[$i] = .fact );
# input: {factorial}
def Decompose($n; $start):
if $start and $start < 2 then []
else
{ factorial,
start: ($start // 18),
m: $n,
f: [] }
| label $out
| foreach range(.start; 1; -1) as $i (.;
.i = $i
| .emit = null
| until (.emit or (.m % .factorial[$i] != 0);
.f += [$i]
| .m = (.m / .factorial[$i])
| if .m == 1 then .emit = .f else . end)
| if .emit then ., break $out else . end)
| if .emit then .emit
elif .i == 2 then Decompose($n; .start-1)
else empty
end
end;
# Input: {factorial}
# $v should be an array of J-P numbers
def synopsis($v):
(100, 800, 1800, 2800, 3800) as $i
| if $v[$i-1] == null
then "\nThe \($i)th Jordan-Pólya number was not found." | error
else "\nThe \($i)th Jordan-Pólya number is \($v[$i-1] )",
([Decompose($v[$i-1]; null) | frequencies]
| map( if (.[1] == 1) then "\(.[0])!" else "(\(.[0])!)^\(.[1])" end)
| " i.e. " + join(" * ") )
end ;
def task:
cacheFactorials(18)
| JordanPolya(pow(2;53)-1; null) as $v
| "\($v|length) Jordan–Pólya numbers have been found. The first 50 are:",
( $v[:50] | tprint(10; 4)),
"\nThe largest Jordan–Pólya number before 100 million: " +
"\(if $v[-1] > 1e8 then last(emit_until(. >= 1e8; $v[])) else "not found" end)",
synopsis($v) ;
task
- Output:
gojq and jq produce the same results except that gojq produces the factorizations in a different order. The output shown here corresponds to the invocation: jq -nr -f jordan-polya-numbers.jq
3887 Jordan–Pólya numbers have been found. The first 50 are: 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: 99532800 The 100th Jordan-Pólya number is 92160 i.e. 6! * (2!)^7 The 800th Jordan-Pólya number is 18345885696 i.e. (4!)^7 * (2!)^2 The 1800th Jordan-Pólya number is 9784472371200 i.e. (6!)^2 * (4!)^2 * (2!)^15 The 2800th Jordan-Pólya number is 439378587648000 i.e. 14! * 7! The 3800th Jordan-Pólya number is 7213895789838336 i.e. (4!)^8 * (2!)^16
Wren
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