Mathematica, (削除) 175 (削除ここまで) (削除) 177 (削除ここまで) (削除) 169 (削除ここまで) 154(削除) 154 (削除ここまで) 108 bytes
Join@@@Table[x[[1]],{s,{1,-1}},{x,r@#},x[[2]]s]&@*(If[#==1,1,{p,e}=Last@(r=FactorInteger)@#;q=1~Max~NextPrime[p,-1];(p/q)^e#0[#(1##&@@Range[q+1,p])@#;p^e#0[p!^-e]]&e#]]&)
If[#==1If[# == 1,
1,
{p,e}= Last @ (r=FactorInteger) @#;
= q=Max[1,NextPrime[p,-1]];Last[FactorInteger[#]];
(p/q)^e #0[#p^e * (1##& @@ Range[q+1,p])#0[p!^-e]e * #]
]&
is a recursive function for actually computing the desired factorization. Given input x (asSpecifically, given a rational number) we find the largest prime factor p appearing ininput x (to the power e), let qwe compute the primes whose factorials should be in the prime before pnumerator and denominator, and recurse on x*(p!/q!)^-ereturn the fraction with all of those primes multiplied together. (So, forFor example, givenon input x=1010/9 we'd pull out a factor of 5 = 2!*5!/(3!*3!*3!) and recurse on, we return 110/1827 = 2*5/(3*3*3).)
This function computesWe do this by dealing with the resultlargest prime factor at every step: if pe occurs in the factorization of x, but (to cancel like factors) it writeswe make sure p!e occurs in the result asfactorial-factorization, and recurse on x divided by p!e.
(Earlier, I had a rationalmore clever strategy that avoids large numbers by looking at the previous prime number. For example before p, 10/9 gets mapped to 2*5/3*3*3 = 10/27but Mathematica can handle numbers as big as 65521! easily, which we want to convert to the list {{2,5},{3,3,3}}so there's no point. That's whatThe old version you can find in the second parthistory is much faster: on my computer, it took 0.05 seconds on inputs that this version handles in 1.6 seconds.)
The second function turns the output of the first function into lists of primes.
Join@@@Table[x[[1]]Join @@@
Table[x[[1]],{s,{1,-1}},{x,r@#FactorInteger[#]},x[[2]]s]&
x[[2]]*s
]&
does: forFor s=1 (positive powers) and s=-1 (negative powers), and for each term {prime,exponent} in the factorization r@#, we repeat the prime number prime exponent*s many times.
Noncompeting version with 109(削除) 109 (削除ここまで) 62 bytes
If[#==1,∇1=1,{p,e}=Last@FactorInteger@#;q=1~Max~NextPrime[p,-1];=Last@FactorInteger@#;(∇p/∇q)^e#0[#(1##&@@Range[q+1,p])^e#0[p!^-e]]&e#]]&
Same as above, but instead of giving output as a list, gives output as an expression, using the ∇ operator (because it has no built-in meaning) as a stand-in for factorials. Thus, an input of 10/9 gives an output of(∇2*∇5)/(∇3)^3 to represent (2!*5!)/(3!)^3.
(∇2 ∇5)/(∇3)^3
-15 bytes: FactorInteger returns sorted output, which we can take advantage of.
-46 bytes: we don't actually need to be clever.
Mathematica, (削除) 175 (削除ここまで) (削除) 177 (削除ここまで) (削除) 169 (削除ここまで) 154 bytes
Join@@@Table[x[[1]],{s,{1,-1}},{x,r@#},x[[2]]s]&@*(If[#==1,1,{p,e}=Last@(r=FactorInteger)@#;q=1~Max~NextPrime[p,-1];(p/q)^e#0[#(1##&@@Range[q+1,p])^-e]]&)
If[#==1,
1,
{p,e}= Last @ (r=FactorInteger) @#;
q=Max[1,NextPrime[p,-1]];
(p/q)^e #0[# * (1##& @@ Range[q+1,p])^-e]
]&
is a recursive function for actually computing the desired factorization. Given input x (as a rational number) we find the largest prime factor p appearing in x (to the power e), let q be the prime before p, and recurse on x*(p!/q!)^-e. (So, for example, given x=10/9 we'd pull out a factor of 5!/3! and recurse on 1/18.)
This function computes the result, but (to cancel like factors) it writes the result as a rational number. For example, 10/9 gets mapped to 2*5/3*3*3 = 10/27, which we want to convert to the list {{2,5},{3,3,3}}. That's what the second part,
Join@@@Table[x[[1]],{s,{1,-1}},{x,r@#},x[[2]]s]&
does: for s=1 (positive powers) and s=-1 (negative powers), and for each term {prime,exponent} in the factorization r@#, we repeat the prime number prime exponent*s many times.
Noncompeting version with 109 bytes
If[#==1,∇1=1,{p,e}=Last@FactorInteger@#;q=1~Max~NextPrime[p,-1];(∇p/∇q)^e#0[#(1##&@@Range[q+1,p])^-e]]&
Same as above, but instead of giving output as a list, gives output as an expression, using the ∇ operator (because it has no built-in meaning) as a stand-in for factorials. Thus, an input of 10/9 gives an output of
(∇2 ∇5)/(∇3)^3
-15 bytes: FactorInteger returns sorted output, which we can take advantage of.
Mathematica, (削除) 175 (削除ここまで) (削除) 177 (削除ここまで) (削除) 169 (削除ここまで) (削除) 154 (削除ここまで) 108 bytes
Join@@@Table[x[[1]],{s,{1,-1}},{x,r@#},x[[2]]s]&@*(If[#==1,1,{p,e}=Last@(r=FactorInteger)@#;p^e#0[p!^-e#]]&)
If[# == 1,
1,
{p,e} = Last[FactorInteger[#]];
p^e * #0[p!^-e * #]
]&
is a recursive function for actually computing the desired factorization. Specifically, given a rational input x, we compute the primes whose factorials should be in the numerator and denominator, and return the fraction with all of those primes multiplied together. (For example, on input 10/9 = 2!*5!/(3!*3!*3!), we return 10/27 = 2*5/(3*3*3).)
We do this by dealing with the largest prime factor at every step: if pe occurs in the factorization of x, we make sure p!e occurs in the factorial-factorization, and recurse on x divided by p!e.
(Earlier, I had a more clever strategy that avoids large numbers by looking at the previous prime number before p, but Mathematica can handle numbers as big as 65521! easily, so there's no point. The old version you can find in the history is much faster: on my computer, it took 0.05 seconds on inputs that this version handles in 1.6 seconds.)
The second function turns the output of the first function into lists of primes.
Join @@@
Table[x[[1]],{s,{1,-1}},{x,FactorInteger[#]},
x[[2]]*s
]&
For s=1 (positive powers) and s=-1 (negative powers), and for each term {prime,exponent} in the factorization r@#, we repeat the prime number prime exponent*s many times.
Noncompeting version with (削除) 109 (削除ここまで) 62 bytes
If[#==1,∇1=1,{p,e}=Last@FactorInteger@#;(∇p)^e#0[p!^-e#]]&
Same as above, but instead of giving output as a list, gives output as an expression, using the ∇ operator (because it has no built-in meaning) as a stand-in for factorials. Thus, an input of 10/9 gives an output of(∇2*∇5)/(∇3)^3 to represent (2!*5!)/(3!)^3.
-15 bytes: FactorInteger returns sorted output, which we can take advantage of.
-46 bytes: we don't actually need to be clever.
- 5.3k
- 14
- 27
Mathematica, (削除) 175 (削除ここまで) (削除) 177 (削除ここまで) 169(削除) 169 (削除ここまで) 154 bytes
Join@@@Table[f@xJoin@@@Table[x[[1]],{s,{1,-1}},{x,r@#},x[[2]]s]&@*(If[#==1,1,{p,e}=(f=First)@MaximalBy[=Last@(r=FactorInteger)@#,f];q=1~Max~NextPrime[p@#;q=1~Max~NextPrime[p,-1];(p/q)^e#0[#(1##&@@Range[q+1,p])^-e]]&)
How it works
This is the composition of two functions. The first, which ungolfs to
If[#==1,
1,
{p,e}=(f=First)@MaximalBy[ Last @ (r=FactorInteger)@#,f]; @#;
q=1~Max~NextPrime[pq=Max[1,NextPrime[p,-1];1]];
(p/q)^e #0[# * (1##&@@Range[q+11##& @@ Range[q+1,p])^-e]
]&
is a recursive function for actually computing the desired numbersfactorization. Given input x, (as a rational number) we find the largest prime factor p appearing in x (to the power e), let q be the prime before p, and recurse on x*(p!/q!)^-e. (So, for example, given x=10/9 we'd pull out a factor of 5!/3! and recurse on 1/18.)
This function computes the result, but (to cancel like factors) it writes the result as a rational number. For example, 10/9 gets mapped to 2*5/3*3*3 = 10/27, which we want to convert to the list {{2,5},{3,3,3}}. That's what the second part,
Join@@@Table[f@xJoin@@@Table[x[[1]],{s,{1,-1}},{x,r@#},x[[2]]s]&
does: for s=1 (positive powers) and s=-1 (negative powers), and for each term {prime,exponent} in the factorization r@#, we repeat the prime number prime exponent*s many times.
Noncompeting version with 129109 bytes
If[∇1=1;#==1If[#==1,1∇1=1,{p,e}=(f=First)@MaximalBy[FactorInteger@#,f];q=1~Max~NextPrime[p=Last@FactorInteger@#;q=1~Max~NextPrime[p,-1];(∇p/∇q)^e#0[#(1##&@@Range[q+1,p])^-e]]&
Same as above, but instead of giving output as a list, gives output as an expression, using the ∇ operator (because it has no built-in meaning) as a stand-in for factorials. Thus, an input of 10/9 gives an output of
(∇2 ∇5)/(∇3)^3
This is shorter because we skip the second part of the function.
+2 bytes: the assignment f=First has to be done in the right place to keep Mathematica from getting upset.
-8 bytes: fixed a bug for integer outputs, which actually made the code shorter.
-15 bytes:)FactorInteger returns sorted output, which we can take advantage of.
Mathematica, (削除) 175 (削除ここまで) (削除) 177 (削除ここまで) 169 bytes
Join@@@Table[f@x,{s,{1,-1}},{x,r@#},x[[2]]s]&@*(If[#==1,1,{p,e}=(f=First)@MaximalBy[(r=FactorInteger)@#,f];q=1~Max~NextPrime[p,-1];(p/q)^e#0[#(1##&@@Range[q+1,p])^-e]]&)
How it works
This is the composition of two functions. The first, which ungolfs to
If[#==1,
1,
{p,e}=(f=First)@MaximalBy[(r=FactorInteger)@#,f];
q=1~Max~NextPrime[p,-1];
(p/q)^e #0[#(1##&@@Range[q+1,p])^-e]
]&
is a recursive function for actually computing the desired numbers. Given input x, we find the largest prime factor p appearing in x (to the power e), let q be the prime before p, and recurse on x*(p!/q!)^-e. (So, for example, given x=10/9 we'd pull out a factor of 5!/3! and recurse on 1/18.)
This function computes the result, but (to cancel like factors) it writes the result as a rational number. For example, 10/9 gets mapped to 2*5/3*3*3 = 10/27, which we want to convert to the list {{2,5},{3,3,3}}. That's what the second part,
Join@@@Table[f@x,{s,{1,-1}},{x,r@#},x[[2]]s]&
does: for s=1 (positive powers) and s=-1 (negative powers), and for each term {prime,exponent} in the factorization r@#, we repeat the prime number prime exponent*s many times.
Noncompeting version with 129 bytes
If[∇1=1;#==1,1,{p,e}=(f=First)@MaximalBy[FactorInteger@#,f];q=1~Max~NextPrime[p,-1];(∇p/∇q)^e#0[#(1##&@@Range[q+1,p])^-e]]&
Same as above, but instead of giving output as a list, gives output as an expression, using the ∇ operator (because it has no built-in meaning) as a stand-in for factorials. Thus, an input of 10/9 gives an output of
(∇2 ∇5)/(∇3)^3
This is shorter because we skip the second part of the function.
+2 bytes: the assignment f=First has to be done in the right place to keep Mathematica from getting upset.
-8 bytes: fixed a bug :)
Mathematica, (削除) 175 (削除ここまで) (削除) 177 (削除ここまで) (削除) 169 (削除ここまで) 154 bytes
Join@@@Table[x[[1]],{s,{1,-1}},{x,r@#},x[[2]]s]&@*(If[#==1,1,{p,e}=Last@(r=FactorInteger)@#;q=1~Max~NextPrime[p,-1];(p/q)^e#0[#(1##&@@Range[q+1,p])^-e]]&)
How it works
This is the composition of two functions. The first, which ungolfs to
If[#==1,
1,
{p,e}= Last @ (r=FactorInteger) @#;
q=Max[1,NextPrime[p,-1]];
(p/q)^e #0[# * (1##& @@ Range[q+1,p])^-e]
]&
is a recursive function for actually computing the desired factorization. Given input x (as a rational number) we find the largest prime factor p appearing in x (to the power e), let q be the prime before p, and recurse on x*(p!/q!)^-e. (So, for example, given x=10/9 we'd pull out a factor of 5!/3! and recurse on 1/18.)
This function computes the result, but (to cancel like factors) it writes the result as a rational number. For example, 10/9 gets mapped to 2*5/3*3*3 = 10/27, which we want to convert to the list {{2,5},{3,3,3}}. That's what the second part,
Join@@@Table[x[[1]],{s,{1,-1}},{x,r@#},x[[2]]s]&
does: for s=1 (positive powers) and s=-1 (negative powers), and for each term {prime,exponent} in the factorization r@#, we repeat the prime number prime exponent*s many times.
Noncompeting version with 109 bytes
If[#==1,∇1=1,{p,e}=Last@FactorInteger@#;q=1~Max~NextPrime[p,-1];(∇p/∇q)^e#0[#(1##&@@Range[q+1,p])^-e]]&
Same as above, but instead of giving output as a list, gives output as an expression, using the ∇ operator (because it has no built-in meaning) as a stand-in for factorials. Thus, an input of 10/9 gives an output of
(∇2 ∇5)/(∇3)^3
This is shorter because we skip the second part of the function.
+2 bytes: the assignment f=First has to be done in the right place to keep Mathematica from getting upset.
-8 bytes: fixed a bug for integer outputs, which actually made the code shorter.
-15 bytes:FactorInteger returns sorted output, which we can take advantage of.
Mathematica, (削除) 175 (削除ここまで) 177(削除) 177 (削除ここまで) 169 bytes
##&@@Table[#Join@@@Table[f@x,Abs@#2]&@@@#&/@GatherBy[r@#{s,Sign@*Last]&@*{1,-1}},{x,r@#},x[[2]]s]&@*(If[#==1,1,{p,e}=(f=First)@MaximalBy[(r=FactorInteger)@#,f];q=1~Max~NextPrime[p,-1];(p/q)^e#0[#(1##&@@Range[q+1,p])^-e]]&)
How it works
This is the composition of two functions. The first, which ungolfs to
If[#==1,
1,
{p,e}=f@MaximalBy[=(f=First)@MaximalBy[(r=FactorInteger)@#,f=First];f];
q=1~Max~NextPrime[p,-1];
(p/q)^e #0[#(1##&@@Range[q+1,p])^-e]
]&
is a recursive function for actually computing the desired numbers. Given input x, we find the largest prime factor p appearing in x (to the power e), let q be the prime before p, and recurse on x*(p!/q!)^-e. (So, for example, given x=10/9 we'd pull out a factor of 5!/3! and recurse on 1/18.)
This function computes the result, but (to cancel like factors) it writes the result as a rational number. For example, 10/9 gets mapped to 2*5/3*3*3 = 10/27, which we want to convert to the list {{2,5},{3,3,3}}. That's what the second part, ungolfing to
##& @@
Table[#Join@@@Table[f@x,Abs@#2]& @@@ #& /@
GatherBy[r@#{s,Sign@*Last]&{1,-1}},{x,r@#},x[[2]]s]&
does: we factorfor 10/27s=1, gather prime factors by the sign of their (positive powers) and s=-1 (negative powers), and un-for each term Tally{prime,exponent} in the listsfactorization r@#, we repeat the prime number primeexponent*s many times.
Noncompeting version with 129 bytes
If[∇1=1;#==1,1,{p,e}=(f=First)@MaximalBy[FactorInteger@#,f];q=1~Max~NextPrime[p,-1];(∇p/∇q)^e#0[#(1##&@@Range[q+1,p])^-e]]&
Same as above, but instead of giving output as a list, gives output as an expression, using the ∇ operator (because it has no built-in meaning) as a stand-in for factorials. Thus, an input of 10/9 gives an output of
(∇2 ∇5)/(∇3)^3
This is shorter because we skip the second part of the function.
+2 bytes: the assignment f=First has to be done in the right place to keep Mathematica from getting upset.
-8 bytes: fixed a bug :)
Mathematica, (削除) 175 (削除ここまで) 177 bytes
##&@@Table[#,Abs@#2]&@@@#&/@GatherBy[r@#,Sign@*Last]&@*(If[#==1,1,{p,e}=(f=First)@MaximalBy[(r=FactorInteger)@#,f];q=1~Max~NextPrime[p,-1];(p/q)^e#0[#(1##&@@Range[q+1,p])^-e]]&)
How it works
This is the composition of two functions. The first, which ungolfs to
If[#==1,
1,
{p,e}=f@MaximalBy[(r=FactorInteger)@#,f=First];
q=1~Max~NextPrime[p,-1];
(p/q)^e #0[#(1##&@@Range[q+1,p])^-e]
]&
is a recursive function for actually computing the desired numbers. Given input x, we find the largest prime factor p appearing in x (to the power e), let q be the prime before p, and recurse on x*(p!/q!)^-e. (So, for example, given x=10/9 we'd pull out a factor of 5!/3! and recurse on 1/18.)
This function computes the result, but (to cancel like factors) it writes the result as a rational number. For example, 10/9 gets mapped to 2*5/3*3*3 = 10/27, which we want to convert to the list {2,5},{3,3,3}. That's what the second part, ungolfing to
##& @@
Table[#,Abs@#2]& @@@ #& /@
GatherBy[r@#,Sign@*Last]&
does: we factor 10/27, gather prime factors by the sign of their powers, and un-Tally the lists.
Noncompeting version with 129 bytes
If[∇1=1;#==1,1,{p,e}=(f=First)@MaximalBy[FactorInteger@#,f];q=1~Max~NextPrime[p,-1];(∇p/∇q)^e#0[#(1##&@@Range[q+1,p])^-e]]&
Same as above, but instead of giving output as a list, gives output as an expression, using the ∇ operator (because it has no built-in meaning) as a stand-in for factorials. Thus, an input of 10/9 gives an output of
(∇2 ∇5)/(∇3)^3
This is shorter because we skip the second part of the function.
+2 bytes: the assignment f=First has to be done in the right place to keep Mathematica from getting upset.
Mathematica, (削除) 175 (削除ここまで) (削除) 177 (削除ここまで) 169 bytes
Join@@@Table[f@x,{s,{1,-1}},{x,r@#},x[[2]]s]&@*(If[#==1,1,{p,e}=(f=First)@MaximalBy[(r=FactorInteger)@#,f];q=1~Max~NextPrime[p,-1];(p/q)^e#0[#(1##&@@Range[q+1,p])^-e]]&)
How it works
This is the composition of two functions. The first, which ungolfs to
If[#==1,
1,
{p,e}=(f=First)@MaximalBy[(r=FactorInteger)@#,f];
q=1~Max~NextPrime[p,-1];
(p/q)^e #0[#(1##&@@Range[q+1,p])^-e]
]&
is a recursive function for actually computing the desired numbers. Given input x, we find the largest prime factor p appearing in x (to the power e), let q be the prime before p, and recurse on x*(p!/q!)^-e. (So, for example, given x=10/9 we'd pull out a factor of 5!/3! and recurse on 1/18.)
This function computes the result, but (to cancel like factors) it writes the result as a rational number. For example, 10/9 gets mapped to 2*5/3*3*3 = 10/27, which we want to convert to the list {{2,5},{3,3,3}}. That's what the second part,
Join@@@Table[f@x,{s,{1,-1}},{x,r@#},x[[2]]s]&
does: for s=1 (positive powers) and s=-1 (negative powers), and for each term {prime,exponent} in the factorization r@#, we repeat the prime number primeexponent*s many times.
Noncompeting version with 129 bytes
If[∇1=1;#==1,1,{p,e}=(f=First)@MaximalBy[FactorInteger@#,f];q=1~Max~NextPrime[p,-1];(∇p/∇q)^e#0[#(1##&@@Range[q+1,p])^-e]]&
Same as above, but instead of giving output as a list, gives output as an expression, using the ∇ operator (because it has no built-in meaning) as a stand-in for factorials. Thus, an input of 10/9 gives an output of
(∇2 ∇5)/(∇3)^3
This is shorter because we skip the second part of the function.
+2 bytes: the assignment f=First has to be done in the right place to keep Mathematica from getting upset.
-8 bytes: fixed a bug :)