Special factorials
From Rosetta Code
Special factorials 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.
This task is an aggregation of lesser-known factorials that nevertheless have some mathematical use.
| Name | Formula | Example calculation | Links |
|---|---|---|---|
| Superfactorial | n sf(n) = ∏ k! k=1 |
sf(4) = 1! × 2! × 3! × 4! = 288 | |
| Hyperfactorial | n H(n) = ∏ kk k=1 |
H(4) = 11 × 22 × 33 × 44 = 27,648 | |
| Alternating factorial | n af(n) = ∑ (-1)n-ii! i=1 |
af(3) = -12×1! + -11×2! + -10×3! = 5 | |
| Exponential factorial | n$ = n(n-1)(n-2)... | 4$ = 4321 = 262,144 |
- Task
- Write a function/procedure/routine for each of the factorials in the table above.
- Show sf(n), H(n), and af(n) where 0 ≤ n ≤ 9. Only show as many numbers as the data types in your language can handle. Bignums are welcome, but not required.
- Show 0$, 1$, 2$, 3$, and 4$.
- Show the number of digits in 5$. (Optional)
- Write a function/procedure/routine to find the inverse factorial (sometimes called reverse factorial). That is, if 5! = 120, then rf(120) = 5. This function is simply undefined for most inputs.
- Use the inverse factorial function to show the inverse factorials of 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, and 3628800.
- Show rf(119). The result should be undefined.
- Notes
- Since the factorial inverse of 1 is both 0 and 1, your function should return 0 in this case since it is normal to use the first match found in a series.
- See also
- Factorial
- Factorions
- Left factorials
- Multifactorial
- Primorial numbers
- Stirling numbers of the first kind
Factor[edit]
USING: formatting io kernel math math.factorials math.functions
math.parser math.ranges prettyprint sequences sequences.extras ;
IN: rosetta-code.special-factorials
: sf ( n -- m ) [1..b] [ n! ] map-product ;
: (H) ( n -- m ) [1..b] [ dup ^ ] map-product ;
: H ( n -- m ) [ 1 ] [ (H) ] if-zero ;
:: af ( n -- m ) n [1..b] [| i | -1 n i - ^ i n! * ] map-sum ;
: $ ( n -- m ) [1..b] [ ] [ swap ^ ] map-reduce ;
: (rf) ( n -- m )
[ 1 1 ] dip [ dup reach > ]
[ [ 1 + [ * ] keep ] dip ] while swapd = swap and ;
: rf ( n -- m ) dup 1 = [ drop 0 ] [ (rf) ] if ;
: .show ( n quot -- )
[ pprint bl ] compose each-integer nl ; inline
"First 10 superfactorials:" print
10 [ sf ] .show nl
"First 10 hyperfactorials:" print
10 [ H ] .show nl
"First 10 alternating factorials:" print
10 [ af ] .show nl
"First 5 exponential factorials:" print
5 [ $ ] .show nl
"Number of digits in 5$:" print
5 $ log10 >integer 1 + . nl
{ 1 2 6 24 120 720 5040 40320 362880 3628800 119 }
[ dup rf "rf(%d) = %u\n" printf ] each nl
- Output:
First 10 superfactorials: 1 1 2 12 288 34560 24883200 125411328000 5056584744960000 1834933472251084800000 First 10 hyperfactorials: 1 1 4 108 27648 86400000 4031078400000 3319766398771200000 55696437941726556979200000 21577941222941856209168026828800000 First 10 alternating factorials: 0 1 1 5 19 101 619 4421 35899 326981 First 5 exponential factorials: 0 1 2 9 262144 Number of digits in 5$: 183231 rf(1) = 0 rf(2) = 2 rf(6) = 3 rf(24) = 4 rf(120) = 5 rf(720) = 6 rf(5040) = 7 rf(40320) = 8 rf(362880) = 9 rf(3628800) = 10 rf(119) = f
Fermat[edit]
Function Sf(n) = Prod<k=1, n>[k!].
Function H(n) = Prod<k=1, n>[k^k].
Function Af(n) = Sigma<i=1,n>[(-1)^(n-i)i!].
Function Ef(n) = if n < 2 then 1 else n^Ef(n-1) fi.
Function Rf(n) =
for r = 1 to n do
rr:=r!;
if rr=n then Return(r) fi;
if rr>n then Return(-1) fi;
od.
for n=0 to 9 do !!(Sf(n), H(n), Af(n)) od;
!!' ';
for n=0 to 4 do !!Ef(n) od;
!!' ';
for n=1 to 10 do !!Rf(n!) od;
!!Rf(119)
FreeBASIC[edit]
Only goes up to H(7) due to overflow. Using a library with big int support is possible, but would only add bloat without being illustrative.
function factorial(n as uinteger) as ulongint
if n<2 then return 1 else return n*factorial(n-1)
end function
function sf(n as uinteger) as ulongint
dim as ulongint p=1
for k as uinteger = 1 to n
p*=factorial(k)
next k
return p
end function
function H( n as uinteger ) as ulongint
dim as ulongint p=1
for k as uinteger = 1 to n
p*=k^k
next k
return p
end function
function af( n as uinteger ) as longint
dim as longint s=0
for i as uinteger = 1 to n
s += (-1)^(n-i)*factorial(i)
next i
return s
end function
function ef( n as uinteger ) as ulongint
if n<2 then return 1 else return n^ef(n-1)
end function
function rf( n as ulongint ) as integer
dim as uinteger r=0,rr
while true
rr=factorial(r)
if rr>n then return -1
if rr=n then return r
r+=1
wend
end function
for n as uinteger = 0 to 7
print sf(n), H(n), af(n)
next n
for n as uinteger = 0 to 4
print ef(n);" ";
next n
print : print
for n as uinteger =0 to 9
print rf(factorial(n));" ";
next n
print rf(119)
Go[edit]
package main
import (
"fmt"
"math/big"
)
func sf(n int) *big.Int {
if n < 2 {
return big.NewInt(1)
}
sfact := big.NewInt(1)
fact := big.NewInt(1)
for i := 2; i <= n; i++ {
fact.Mul(fact, big.NewInt(int64(i)))
sfact.Mul(sfact, fact)
}
return sfact
}
func H(n int) *big.Int {
if n < 2 {
return big.NewInt(1)
}
hfact := big.NewInt(1)
for i := 2; i <= n; i++ {
bi := big.NewInt(int64(i))
hfact.Mul(hfact, bi.Exp(bi, bi, nil))
}
return hfact
}
func af(n int) *big.Int {
if n < 1 {
return new(big.Int)
}
afact := new(big.Int)
fact := big.NewInt(1)
sign := new(big.Int)
if n%2 == 0 {
sign.SetInt64(-1)
} else {
sign.SetInt64(1)
}
t := new(big.Int)
for i := 1; i <= n; i++ {
fact.Mul(fact, big.NewInt(int64(i)))
afact.Add(afact, t.Mul(fact, sign))
sign.Neg(sign)
}
return afact
}
func ef(n int) *big.Int {
if n < 1 {
return big.NewInt(1)
}
t := big.NewInt(int64(n))
return t.Exp(t, ef(n-1), nil)
}
func rf(n *big.Int) int {
i := 0
fact := big.NewInt(1)
for {
if fact.Cmp(n) == 0 {
return i
}
if fact.Cmp(n) > 0 {
return -1
}
i++
fact.Mul(fact, big.NewInt(int64(i)))
}
}
func main() {
fmt.Println("First 10 superfactorials:")
for i := 0; i < 10; i++ {
fmt.Println(sf(i))
}
fmt.Println("\nFirst 10 hyperfactorials:")
for i := 0; i < 10; i++ {
fmt.Println(H(i))
}
fmt.Println("\nFirst 10 alternating factorials:")
for i := 0; i < 10; i++ {
fmt.Print(af(i), " ")
}
fmt.Println("\n\nFirst 5 exponential factorials:")
for i := 0; i <= 4; i++ {
fmt.Print(ef(i), " ")
}
fmt.Println("\n\nThe number of digits in 5$ is", len(ef(5).String()))
fmt.Println("\nReverse factorials:")
facts := []int64{1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 119}
for _, fact := range facts {
bfact := big.NewInt(fact)
rfact := rf(bfact)
srfact := fmt.Sprintf("%d", rfact)
if rfact == -1 {
srfact = "none"
}
fmt.Printf("%4s <- rf(%d)\n", srfact, fact)
}
}
- Output:
First 10 superfactorials: 1 1 2 12 288 34560 24883200 125411328000 5056584744960000 1834933472251084800000 First 10 hyperfactorials: 1 1 4 108 27648 86400000 4031078400000 3319766398771200000 55696437941726556979200000 21577941222941856209168026828800000 First 10 alternating factorials: 0 1 1 5 19 101 619 4421 35899 326981 First 5 exponential factorials: 1 1 2 9 262144 The number of digits in 5$ is 183231 Reverse factorials: 0 <- rf(1) 2 <- rf(2) 3 <- rf(6) 4 <- rf(24) 5 <- rf(120) 6 <- rf(720) 7 <- rf(5040) 8 <- rf(40320) 9 <- rf(362880) 10 <- rf(3628800) none <- rf(119)
Julia[edit]
No recursion.
superfactorial(n) = n < 1 ? 1 : mapreduce(factorial, *, 1:n)
sf(n) = superfactorial(n)
hyperfactorial(n) = n < 1 ? 1 : mapreduce(i -> i^i, *, 1:n)
H(n) = hyperfactorial(n)
alternating_factorial(n) = n < 1 ? 0 : mapreduce(i -> (-1)^(n - i) * factorial(i), +, 1:n)
af(n) = alternating_factorial(n)
exponential_factorial(n) = n < 1 ? 1 : foldl((x, y) -> y^x, 1:n)
n＄(n) = exponential_factorial(n)
function reverse_factorial(n)
n == 1 && return 0
fac = one(n)
for i in 2:10000
fac *= i
fac == n && return i
fac > n && break
end
return nothing
end
rf(n) = reverse_factorial(n)
println("N Superfactorial Hyperfactorial", " "^18, "Alternating Factorial Exponential Factorial\n", "-"^98)
for n in 0:9
print(n, " ")
for f in [sf, H, af, n＄]
if n < 5 || f != n＄
print(rpad(f(Int128(n)), f == H ? 37 : 24))
end
end
println()
end
println("\nThe number of digits in n＄(5) is ", length(string(n＄(BigInt(5)))))
println("\n\nN Reverse Factorial\n", "-"^25)
for n in [1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 119]
println(rpad(n, 10), rf(n))
end
- Output:
N Superfactorial Hyperfactorial Alternating Factorial Exponential Factorial -------------------------------------------------------------------------------------------------- 0 1 1 0 1 1 1 1 1 1 2 2 4 1 2 3 12 108 5 9 4 288 27648 19 262144 5 34560 86400000 101 6 24883200 4031078400000 619 7 125411328000 3319766398771200000 4421 8 5056584744960000 55696437941726556979200000 35899 9 1834933472251084800000 21577941222941856209168026828800000 326981 The number of digits in n＄(5) is 183231 N Reverse Factorial ------------------------- 1 0 2 2 6 3 24 4 120 5 720 6 5040 7 40320 8 362880 9 3628800 10 119 nothing
Perl[edit]
use strict;
use warnings;
use feature qw<signatures say>;
no warnings qw<experimental::signatures>;
use bigint try => 'GMP';
use ntheory qw<vecprod vecsum vecreduce vecfirstidx>;
sub f ($n) { vecreduce { $a * $b } 1, 1..$n }
sub sf ($n) { vecprod map { f($_) } 1..$n }
sub H ($n) { vecprod map { $_ ** $_ } 1..$n }
sub af ($n) { vecsum map { (-1) ** ($n-$_) * f($_) } 1..$n }
sub ef ($n) { vecreduce { $b ** $a } 1..$n }
sub rf ($n) {
my $v = vecfirstidx { f($_) >= $n } 0..1E6;
$n == f($v) ? $v : 'Nope'
}
say 'sf : ' . join ' ', map { sf $_ } 0..9;
say 'H : ' . join ' ', map { H $_ } 0..9;
say 'af : ' . join ' ', map { af $_ } 0..9;
say 'ef : ' . join ' ', map { ef $_ } 1..4;
say '5$ has ' . length(5**4**3**2) . ' digits';
say 'rf : ' . join ' ', map { rf $_ } <1 2 6 24 120 720 5040 40320 362880 3628800>;
say 'rf(119) = ' . rf(119);
- Output:
sf : 1 1 2 12 288 34560 24883200 125411328000 5056584744960000 1834933472251084800000 H : 1 1 4 108 27648 86400000 4031078400000 3319766398771200000 55696437941726556979200000 21577941222941856209168026828800000 af : 0 1 1 5 19 101 619 4421 35899 326981 ef : 1 2 9 262144 5$ has 183231 digits rf : 0 2 3 4 5 6 7 8 9 10 rf(119) = Nope
Phix[edit]
Rather than leave this as four somewhat disjoint tasks with quite a bit of repetition, I commoned-up init/loop/print into test(), which means sf/H/af/ef aren't usable independently as-is, but reconstitution should be easy enough (along with somewhat saner and thread-safe routine-local vars).
include mpfr.e mpz {r,fn} = mpz_inits(2) -- res, scratch var procedure sf(integer i) mpz_fac_ui(fn, i) mpz_mul(r,r,fn) end procedure procedure H(integer i) mpz_ui_pow_ui(fn, i, i) mpz_mul(r,r,fn) end procedure integer sgn = 0 procedure af(integer i) mpz_fac_ui(fn, i) mpz_mul_si(fn,fn,sgn) sgn *= -1 mpz_add(r,r,fn) end procedure procedure ef(integer i) integer e = mpz_get_integer(r) mpz_set_si(r,i) mpz_pow_ui(r, r, e) end procedure procedure test(string fmt, integer fn, init=1, m=9) sequence res = {} for n=0 to m do mpz_set_si(r,init) sgn = iff(and_bits(n,1)?1:-1) -- (af only) for i=1 to n do fn(i) -- or papply(tagset(n),fn) end for res = append(res,mpz_get_str(r)) end for printf(1,fmt,{join(res)}) end procedure test("First 10 superfactorials: %s\n",sf) test("First 10 hyperfactorials: %s\n",H) test("First 10 alternating factorials: %s\n",af,0) test("First 5 exponential factorials: %s\n",ef,1,4) ef(5) -- (nb now only works because ef(4) was just called) printf(1,"Number of digits in 5$: %,d\n",mpz_sizeinbase(r,10)) function rf(integer n) if n=1 then return "0" end if integer fac = 1, i = 1 while fac<n do fac *= i if fac=n then return sprint(i) end if i += 1 end while return "undefined" end function printf(1,"Reverse factorials: %s\n",{join(apply({1,2,6,24,120,720,5040,40320,362880,3628800,119},rf))})
- Output:
First 10 superfactorials: 1 1 2 12 288 34560 24883200 125411328000 5056584744960000 1834933472251084800000 First 10 hyperfactorials: 1 1 4 108 27648 86400000 4031078400000 3319766398771200000 55696437941726556979200000 21577941222941856209168026828800000 First 10 alternating factorials: 0 1 1 5 19 101 619 4421 35899 326981 First 5 exponential factorials: 1 1 2 9 262144 Number of digits in 5$: 183,231 Reverse factorials: 0 2 3 4 5 6 7 8 9 10 undefined
Raku[edit]
sub postfix:<!> ($n) { [*] 1 .. $n }
sub postfix:<$> ($n) { [R**] 1 .. $n }
sub sf ($n) { [*] map { $_! }, 1 .. $n }
sub H ($n) { [*] map { $_ ** $_ }, 1 .. $n }
sub af ($n) { [+] map { (-1) ** ($n - $_) * $_! }, 1 .. $n }
sub rf ($n) {
state @f = 1, |[\*] 1..*;
$n == .value ?? .key !! Nil given @f.first: :p, * >= $n;
}
say 'sf : ', map &sf , 0..9;
say 'H : ', map &H , 0..9;
say 'af : ', map &af , 0..9;
say '$ : ', map *$ , 1..4;
say '5$ has ', 5$.chars, ' digits';
say 'rf : ', map &rf, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800;
say 'rf(119) = ', rf(119).raku;
- Output:
sf : (1 1 2 12 288 34560 24883200 125411328000 5056584744960000 1834933472251084800000) H : (1 1 4 108 27648 86400000 4031078400000 3319766398771200000 55696437941726556979200000 21577941222941856209168026828800000) af : (0 1 1 5 19 101 619 4421 35899 326981) $ : (1 2 9 262144) 5$ has 183231 digits rf : (0 2 3 4 5 6 7 8 9 10) rf(119) = Nil
REXX[edit]
/*REXX program to compute some special factorials: superfactorials, hyperfactorials,*/
/*───────────────────────────────────── alternating factorials, exponential factorials.*/
numeric digits 100 /*allows humongous results to be shown.*/
call hdr 'super'; do j=0 to 9; $= $ sf(j); end; call tell
call hdr 'hyper'; do j=0 to 9; $= $ hf(j); end; call tell
call hdr 'alternating '; do j=0 to 9; $= $ af(j); end; call tell
call hdr 'exponential '; do j=0 to 5; $= $ ef(j); end; call tell
@= 'the number of decimal digits in the exponential factorial of '
say @ 5 " is:"; $= ' 'commas( efn( ef(5) ) ); call tell
@= 'the inverse factorial of'
do j=1 for 10; say @ right(!(j), 8) " is: " rf(!(j))
end /*j*/
say @ right(119, 8) " is: " rf(119)
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
!: procedure; parse arg x; != 1; do #=2 to x; != ! * #; end; return !
af: procedure; parse arg x; if x==0 then return 0; prev= 0; call af!; return !
af!: do #=1 for x; != !(#) - prev; prev= !; end; return !
commas: parse arg ?; do jc=length(?)-3 to 1 by -3; ?=insert(',', ?, jc); end; return ?
ef: procedure; parse arg x; if x==0 | x==1 then return 1; return x**ef(x-1)
efn: procedure; parse arg x; numeric digits 9; x= x; parse var x 'E' d; return d+1
sf: procedure; parse arg x; != 1; do #=2 to x; != ! * !(#); end; return !
hf: procedure; parse arg x; != 1; do #=2 to x; != ! * #**#; end; return !
rf: procedure; parse arg x; do #=0 until f>=x; f=!(#); end; return rfr()
rfr: if x==f then return #; ?= 'undefined'; return ?
hdr: parse arg ?,,$; say 'the first ten '?"factorials:"; return
tell: say substr($, 2); say; $=; return
- output when using the internal default input:
the first 10 superfactorials: 1 1 2 12 288 34560 24883200 125411328000 5056584744960000 1834933472251084800000 the first 10 hyperfactorials: 1 1 4 108 27648 86400000 4031078400000 3319766398771200000 55696437941726556979200000 21577941222941856209168026828800000 the first 10 alternating factorials: 0 1 1 5 19 101 619 4421 35899 326981 the first 5 exponential factorials: 1 1 2 9 262144 the number of decimal digits in the exponential factorial of 5 is: 183,231 the inverse factorial of 1 is: 0 the inverse factorial of 2 is: 2 the inverse factorial of 6 is: 3 the inverse factorial of 24 is: 4 the inverse factorial of 120 is: 5 the inverse factorial of 720 is: 6 the inverse factorial of 5040 is: 7 the inverse factorial of 40320 is: 8 the inverse factorial of 362880 is: 9 the inverse factorial of 3628800 is: 10 the inverse factorial of 119 is: undefined
Wren[edit]
We've little choice but to use BigInt here as Wren can only deal natively with integers up to 2^53.
import "/big" for BigInt
import "/fmt" for Fmt
var sf = Fn.new { |n|
if (n < 2) return BigInt.one
var sfact = BigInt.one
var fact = BigInt.one
for (i in 2..n) {
fact = fact * i
sfact = sfact * fact
}
return sfact
}
var H = Fn.new { |n|
if (n < 2) return BigInt.one
var hfact = BigInt.one
for (i in 2..n) hfact = hfact * BigInt.new(i).pow(i)
return hfact
}
var af = Fn.new { |n|
if (n < 1) return BigInt.zero
var afact = BigInt.zero
var fact = BigInt.one
var sign = (n%2 == 0) ? -1 : 1
for (i in 1..n) {
fact = fact * i
afact = afact + fact * sign
sign = -sign
}
return afact
}
var ef // recursive
ef = Fn.new { |n|
if (n < 1) return BigInt.one
return BigInt.new(n).pow(ef.call(n-1))
}
var rf = Fn.new { |n|
var i = 0
var fact = BigInt.one
while (true) {
if (fact == n) return i
if (fact > n) return "none"
i = i + 1
fact = fact * i
}
}
System.print("First 10 superfactorials:")
for (i in 0..9) System.print(sf.call(i))
System.print("\nFirst 10 hyperfactorials:")
for (i in 0..9) System.print(H.call(i))
System.print("\nFirst 10 alternating factorials:")
for (i in 0..9) System.write("%(af.call(i)) ")
System.print("\n\nFirst 5 exponential factorials:")
for (i in 0..4) System.write("%(ef.call(i)) ")
System.print()
Fmt.print("\nThe number of digits in 5$$ is $,d\n", ef.call(5).toString.count)
System.print("Reverse factorials:")
var facts = [1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 119]
for (fact in facts) Fmt.print("$4s <- rf($d)", rf.call(fact), fact)
- Output:
First 10 superfactorials: 1 1 2 12 288 34560 24883200 125411328000 5056584744960000 1834933472251084800000 First 10 hyperfactorials: 1 1 4 108 27648 86400000 4031078400000 3319766398771200000 55696437941726556979200000 21577941222941856209168026828800000 First 10 alternating factorials: 0 1 1 5 19 101 619 4421 35899 326981 First 5 exponential factorials: 1 1 2 9 262144 The number of digits in 5$ is 183,231 Reverse factorials: 0 <- rf(1) 2 <- rf(2) 3 <- rf(6) 4 <- rf(24) 5 <- rf(120) 6 <- rf(720) 7 <- rf(5040) 8 <- rf(40320) 9 <- rf(362880) 10 <- rf(3628800) none <- rf(119)
