CREATE combperm.txt  \ Leo Wong  28 April 02003 fyj +
\ #items array combinations combos combperm.txt drops factorial maxset
\ ncombinations perms permutations set subset xcombo xperm xperms

\ : factorial ( +n1 -- +n2)
\    DUP 2 < IF  DROP 1 EXIT  THEN DUP 1-  RECURSE * ;
\ : factorial ( +n1 -- +n2)
\   DUP 2 < IF  DROP 1 EXIT  THEN
\    DUP BEGIN DUP 2 > WHILE 1-  SWAP OVER *  SWAP REPEAT  DROP ;

: factorial  ( +n -- n! )
   1 SWAP  BEGIN ?DUP WHILE TUCK * SWAP 1- REPEAT ;

\ permutations after Er Hersom, Forthwrite, Issue 109, November 2000
0 value #items
DEFER xPerm
: xPerms   ( #items -- )  CR  0 ?DO I PICK xPerm LOOP ; ' . is xPerm
: perms  ( #items -- ) 
  DUP 1 = IF >R #items xPerms R>
  ELSE DUP 0 DO >R  R@ 1- RECURSE ROLL R> LOOP THEN ;
: drops ( N -- )  0 ?DO DROP LOOP ;
: permutations  ( n -- )
   DUP >R 0 ?DO I LOOP r@ to #items R> perms drops ;

\ combinations of a set of elements a subset at a time, after
\ http://www.cs.rutgers.edu/~djimenez/ut/utsa/cs3343/lecture25.html
: ncombinations  ( n k -- # )
   >R DUP factorial SWAP R@ - factorial R> factorial * / ;

0 VALUE subset
0 VALUE set
20 VALUE maxset
: array  CREATE  ( n -- ) CELLS ALLOT DOES> ( n -- a )  SWAP CELLS + ;
maxset array vector

DEFER xCombo  ( -- )
:NONAME CR  0 vector subset 0 ?DO DUP ? CELL+ LOOP DROP ; IS xCombo

: combos  ( nth start -- nth )
   OVER subset = IF xCombo DROP EXIT THEN
   set SWAP ?DO I OVER vector ! DUP 1+ I 1+ RECURSE DROP LOOP ;

: combinations  ( set subset<=set -- )
   OVER maxset > ABORT" vector too small in combperm.txt"
   2DUP < ABORT" set<subset in combinations -- )"
   TO subset  TO set  0 0 combos DROP ;