steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.factorials: handle more inputs in factorial/.

db4
John Benediktsson 2013-04-08 15:08:53 -07:00
parent a12728d5a3
commit cda0092fec
2 changed files with 12 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
extra/math/factorials/factorials-tests.factor
View File

@ -10,6 +10,9 @@ IN: math.factorials
{ 720 } [ 10 7 factorial/ ] unit-test { 720 } [ 10 7 factorial/ ] unit-test
{ 604800 } [ 10 3 factorial/ ] unit-test { 604800 } [ 10 3 factorial/ ] unit-test
{ 3628800 } [ 10 0 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 { 17160 } [ 10 4 rising-factorial ] unit-test
{ 1/57120 } [ 10 -4 rising-factorial ] unit-test { 1/57120 } [ 10 -4 rising-factorial ] unit-test

12
extra/math/factorials/factorials.factor
View File

@ -9,9 +9,15 @@ IN: math.factorials
MEMO: factorial ( n -- n! ) MEMO: factorial ( n -- n! )
dup 1 > [ [1,b] product ] [ drop 1 ] if ; dup 1 > [ [1,b] product ] [ drop 1 ] if ;
:: factorial/ ( n k -- n!/k! ) : factorial/ ( n k -- n!/k! )
{ [ k 0 < ] [ n 0 < ] [ k n > ] } 0|| {
[ 0 ] [ k n (a,b] product ] if ; { [ 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) ) : rising-factorial ( x n -- x(n) )
{ {