math.factorials: handle more inputs in factorial/.

diff --git a/extra/math/factorials/factorials-tests.factor b/extra/math/factorials/factorials-tests.factor
index cd110d515ab6bf0e27975f0543a40d361162a66a..52684a366bbc488dad90b6d6e3c1b7b3d73bb8be 100644 (file)
--- a/extra/math/factorials/factorials-tests.factor
+++ b/extra/math/factorials/factorials-tests.factor
@@ -10,6 +10,9 @@ IN: math.factorials
 { 720 } [ 10 7 factorial/ ] unit-test
 { 604800 } [ 10 3 factorial/ ] unit-test
 { 3628800 } [ 10 0 factorial/ ] unit-test
+{ 6 } [ 3 -3 factorial/ ] unit-test
+{ 1/6 } [ -3 3 factorial/ ] unit-test
+{ 1/720 } [ 7 10 factorial/ ] unit-test
 
 { 17160 } [ 10 4 rising-factorial ] unit-test
 { 1/57120 } [ 10 -4 rising-factorial ] unit-test

diff --git a/extra/math/factorials/factorials.factor b/extra/math/factorials/factorials.factor
index 07664fc89b3e940dfd410e1a89ea15e2670f006b..493f5f228f14d7d2a2de0a5d4de9458210cac811 100644 (file)
--- a/extra/math/factorials/factorials.factor
+++ b/extra/math/factorials/factorials.factor
@@ -9,9 +9,15 @@ IN: math.factorials
 MEMO: factorial ( n -- n! )
     dup 1 > [ [1,b] product ] [ drop 1 ] if ;
 
-:: factorial/ ( n k -- n!/k! )
-    { [ k 0 < ] [ n 0 < ] [ k n > ] } 0||
-    [ 0 ] [ k n (a,b] product ] if ;
+: factorial/ ( n k -- n!/k! )
+    {
+        { [ dup 1 < ] [ drop factorial ] }
+        { [ over 1 < ] [ nip factorial recip ] }
+        [
+            2dup < [ t ] [ swap f ] if
+            [ (a,b] product ] dip [ recip ] when
+        ]
+    } cond ;
 
 : rising-factorial ( x n -- x(n) )
     {