factor: trim using lists

[factor.git] / extra / math / factorials / factorials.factor

diff --git a/extra/math/factorials/factorials.factor b/extra/math/factorials/factorials.factor
index 8760ce537fca7dcc9e97143369a0d65cea31bd3e..06d3eac0285a4db4d38dd3a502fd3c9cdaf02c80 100644 (file)
--- a/extra/math/factorials/factorials.factor
+++ b/extra/math/factorials/factorials.factor
@@ -1,20 +1,27 @@
 ! 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 combinators.short-circuit inverse kernel
+math math.functions math.primes ranges sequences ;
 
 IN: math.factorials
 
 MEMO: factorial ( n -- n! )
-    dup 1 > [ [1,b] product ] [ drop 1 ] if ;
+    dup 1 > [ [1..b] product ] [ drop 1 ] if ;
 
 ALIAS: n! factorial
 
+: factorials ( n -- seq )
+    1 swap [0..b] [ dup 1 > [ * ] [ drop ] if dup ] map nip ;
+
 MEMO: double-factorial ( n -- n!! )
-    dup 1 > [
-        dup even? 2 1 ? swap 2 <range> product
-    ] [ drop 1 ] if ;
+    dup [ even? ] [ 0 < ] bi [
+        [ drop 1/0. ] [
+            2 + -1 swap -2 <range> product recip
+        ] if
+    ] [
+        2 3 ? swap 2 <range> product
+    ] if ;
 
 ALIAS: n!! double-factorial
 
@@ -24,7 +31,7 @@ ALIAS: n!! double-factorial
         { [ over 1 <= ] [ nip factorial recip ] }
         [
             2dup < [ t ] [ swap f ] if
-            [ (a,b] product ] dip [ recip ] when
+            [ (a..b] product ] dip [ recip ] when
         ]
     } cond ;
 
@@ -34,7 +41,7 @@ ALIAS: n!! double-factorial
         { 0 [ drop 0 ] }
         [
             dup 0 < [ neg [ + ] keep t ] [ f ] if
-            [ dupd + [a,b) product ] dip
+            [ dupd + [a..b) product ] dip
             [ recip ] when
         ]
     } case ;
@@ -47,7 +54,7 @@ ALIAS: pochhammer rising-factorial
         { 0 [ drop 0 ] }
         [
             dup 0 < [ neg [ + ] keep t ] [ f ] if
-            [ dupd - swap (a,b] product ] dip
+            [ dupd - swap (a..b] product ] dip
             [ recip ] when
         ]
     } case ;
@@ -66,3 +73,53 @@ 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 ;
+
+: alternating-factorial ( n -- m )
+    dup 1 > [
+        [ [1..b] ] keep even? '[
+            [ factorial ] [ odd? _ = ] bi [ neg ] when
+        ] map-sum
+    ] [ drop 1 ] if ;
+
+: exponential-factorial ( n -- m )
+    dup 1 > [ [1..b] 1 [ swap ^ ] reduce ] [ drop 1 ] if ;
+
+<PRIVATE
+
+: -prime? ( n quot: ( n -- m ) -- ? )
+    [ 1 1 [ pick over - 1 <= ] ] dip
+    '[ drop [ 1 + ] _ bi ] until nip - abs 1 = ; inline
+
+PRIVATE>
+
+: factorial-prime? ( n -- ? )
+    { [ prime? ] [ [ factorial ] -prime? ] } 1&& ;
+
+: primorial-prime? ( n -- ? )
+    { [ prime? ] [ 2 > ] [ [ primorial ] -prime? ] } 1&& ;
+
+: reverse-factorial ( m -- n )
+    1 1 [ 2over > ] [ 1 + [ * ] keep ] while [ = ] dip and ;
+
+\ factorial [ reverse-factorial ] define-inverse