diff --git a/extra/math/factorials/factorials-tests.factor b/extra/math/factorials/factorials-tests.factor index 933646cda9..976bba91a0 100644 --- a/extra/math/factorials/factorials-tests.factor +++ b/extra/math/factorials/factorials-tests.factor @@ -44,3 +44,19 @@ IN: math.factorials { 11960 } [ 20 3 -3 factorial-power ] unit-test { t } [ 20 3 [ 1 factorial-power ] [ falling-factorial ] 2bi = ] unit-test { t } [ 20 3 [ 0 factorial-power ] [ ^ ] 2bi = ] unit-test + +{ { 1 2 6 30 210 2310 } } [ 6 iota [ primorial ] map ] unit-test + +{ t } [ + 6 iota + [ [ double-factorial ] map ] + [ [ 2 multifactorial ] map ] + bi = +] unit-test + +{ { 1 2 12 120 1680 30240 } } +[ 6 iota [ quadruple-factorial ] map ] unit-test + +{ { 1 1 2 12 288 } } [ 5 iota [ super-factorial ] map ] unit-test + +{ { 1 1 4 108 27648 } } [ 5 iota [ hyper-factorial ] map ] unit-test diff --git a/extra/math/factorials/factorials.factor b/extra/math/factorials/factorials.factor index 699edd6665..7964713c78 100644 --- a/extra/math/factorials/factorials.factor +++ b/extra/math/factorials/factorials.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2013 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: combinators kernel math math.functions math.ranges -memoize sequences ; +USING: combinators kernel math math.functions math.primes +math.ranges memoize sequences ; IN: math.factorials @@ -70,3 +70,24 @@ ALIAS: pochhammer rising-factorial ] if ] } case ; + +: primorial ( n -- p# ) + dup 0 > [ nprimes product ] [ drop 1 ] if ; + +: multifactorial ( n k -- n!(k) ) + 2dup >= [ + dupd [ - ] keep multifactorial * + ] [ 2drop 1 ] if ; inline recursive + +: quadruple-factorial ( n -- m ) + [ 2 * ] keep factorial/ ; + +: super-factorial ( n -- m ) + dup 1 > [ + [1,b] [ factorial ] [ * ] map-reduce + ] [ drop 1 ] if ; + +: hyper-factorial ( n -- m ) + dup 1 > [ + [1,b] [ dup ^ ] [ * ] map-reduce + ] [ drop 1 ] if ;