diff --git a/extra/math/factorials/factorials-tests.factor b/extra/math/factorials/factorials-tests.factor index cd110d515a..52684a366b 100644 --- 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 07664fc89b..493f5f228f 100644 --- 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) ) {