math.factorials: more factorial words.

diff --git a/extra/math/factorials/factorials-tests.factor b/extra/math/factorials/factorials-tests.factor
index 933646cda94799a5835afd024771b636f123e04c..976bba91a0626d9c6ea59ddc720fff25142fb618 100644 (file)
--- 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 699edd66650c74740f3de28abf9f6e3a08f1e1dd..7964713c783f97c513565c68dc07c45859cf1759 100644 (file)
--- 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 ;