libs/math/combinatorics.factor

   1 IN: math-contrib
   2 USING: arrays kernel sequences errors namespaces math ;
   3
   4 : <range> ( from to -- seq ) dup <slice> ; inline
   5 : (0..n] ( n -- (0..n] ) 1+ 1 swap <range> ; inline
   6 : [1..n] ( n -- [1..n] ) (0..n] ; inline
   7 : [k..n] ( k n -- [k..n] ) 1+ <range> ; inline
   8 : (k..n] ( k n -- (k..n] ) [ 1+ ] 2apply <range> ; inline
   9
  10 : Z:(-inf,0]? ( n -- bool )
  11     #! nonpositive integer
  12     dup 0 <= [ integer? ] [ drop f ] if ;
  13
  14 : factorial ( n -- n! ) (0..n] product ;
  15
  16 : factorial-part ( k! k n -- n! )
  17     #! calculate n! given n, k, k!
  18     (k..n] product * ;
  19
  20 : nCk ( n k -- nCk )
  21     #! uses the results from min(k!,(n-k)!) to compute max(k!,(n-k)!)
  22     #! use max(k!,(n-k)!) to compute n!
  23     2dup < [
  24         2drop 0
  25     ] [
  26         [ - ] 2keep rot 2dup < [ swap ] when
  27         [ factorial ] keep over
  28         >r rot [ factorial-part ] keep rot pick >r factorial-part r> r> * /
  29     ] if ;
  30
  31 : nPk ( n k -- nPk )
  32     #! uses the results from (n-k)! to compute n!
  33     2dup < [
  34         2drop 0
  35     ] [
  36         2dup - nip [ factorial ] keep rot pick >r factorial-part r> /
  37     ] if ;
  38
  39 : inverse-permutation ( seq -- seq )
  40     dup length dup 0 <array> -rot swap [ pick set-nth ] 2each ;
  41