In my workday language, instead of searching among an array of available
numbers until I found one, which had not already been chosen, I would
use a set of available numbers and when one was chosen, I would simply
delete it from the set.  Thus I would not go over the chosen numbers
more than once.

Is there a way to create a set in Forth?  Of course, there is.  I could
do it with a linked list and when a number is chosen, simply reorient
the links to/from it, essentially removing it from the list.

Is there another or better way?

This is part of the iForth distribution.

-marcel

-- ------------------------------------------------------------------------
ANEW -floyd

DOC Floyd's algorithm F2 for a deck of cards.
(*
 The general algorithm F2 draws M numbers from a collection of N.
 The M numbers are called "a random sample without duplicates."
 It is guaranteed that each random sample has a probability 1/(N M)
 i.e. (N-M)! * M! / N!.

 Recursive definition:
 function sample(M,N)
     IF M=0 THEN return empty(S)
     S = sample(M-1,N-1)
     T = choose(N)
     IF T is not in S THEN insert T in S
     ELSE insert N in S
     return S

 Or: To generate a 5-element sample from 0..9, we first generate a 4-element sample
     from 0..8, and then add the fifth element.

 Initialize sequence S to empty
 for I := N-M to N-1 do
     T := random(0,I-1)
     if T is not in S then
         prefix T to S
    else insert I in S after T

 Wanted a random sequence of 52 integers in the range 0..51,
  Initialize deck to empty
  FOR I := 0 TO 51 DO
      T := choose(I)
      IF T is not in deck THEN
           prefix T to deck
      ELSE insert I in deck after T

 Advantages of Floyd's algorithm over shuffling the numbers 0..51?
 The guarantee. How many shuffles are needed? Clearly shuffling
 again does not make the sample "more random", but not shuffling is
 clearly wrong also. F2 can be used when M <> N, shuffling?

 The algorithm above doesn't look terribly efficient with the
 insertions (for large sets a linked list can be used).
*)
ENDDOC

\ -- DATA -----------------------------------------------------------
0 VALUE #ix  
CREATE deck #52 CHARS ALLOT

\ -- FLOYD'S ALGORITHM ----------------------------------------------
: initialize ( -- ) 0 TO #ix ;

\ As Ewald Pfau has noted: this is quite nearly SCAN
: is_not_in_deck? ( n -- ix+1 false | 0 "true" )
        #ix 0 ?DO deck I + C@  
                  over = IF DROP i 1+ false unloop exit ENDIF
             LOOP DROP 0 true ;

: insert_in_deck_after ( index n -- )  
        SWAP >R  deck R@ +  DUP 1+  #ix R@ - MOVE
        deck R> + C!  1 +TO #ix ;

: SHUFFLE ( -- )
        initialize
        #52 0 DO i 1+ choose  DUP is_not_in_deck?
                    IF SWAP
                  ELSE NIP i
                 ENDIF insert_in_deck_after
            LOOP ;

\ -- AUTO-TEST ------------------------------------------------------
: .DECK ( -- )
        #ix 0 ?DO i #16 mod 0= IF cr ENDIF
                  deck I + C@ 3 .R space
             LOOP ;

CREATE flags #52 ALLOT
: TEST ( -- )
        flags #52 ERASE
        #52 0 ?DO 1  deck I + C@  flags + C+!  LOOP
        #52 0 ?DO flags I + C@ 1 <>
                  IF CR ." SHUFFLE :: not OK at " I . ENDIF
             LOOP ;

\ 1.5 times faster than Zegub's
: .SPEED ( -- )
        CR TIMER-RESET #1000 0 DO  SHUFFLE  LOOP
        MS? . ." microseconds per shuffle" ;

\ CR .( Testing SHUFFLE)
\ CR .( Decks should be "random." Press any key to stop...)
\ CR SHUFFLE TEST .DECK MANY

\ -- Tom Zegub --------------------------------------------------------------------------- --------
0 [IF] TITLE - DEMO,  CARDS
  LEXICON:
   DECK:        DEFINE  DECK OF CARDS
   IDECK        INIT DECK
   SHUFFLE      SHUFFLE DECK
   SHOW         SHOW DECK
   FUSSY?       VALUE, SET TO TRUE TO ENABLE SHUFFLE FUZZINESS
  NEEDS (COMUS):  
   C@+ C!+ CHAR- CEXCH ENUM RANDOM    
[THEN]

: C!+   ( addr n -- addr2 ) OVER C! 1+ ;
: CEXCH ( addr1 addr2 --  ) OVER C@ OVER C@  SWAP ROT C!  SWAP C! ;
: ENUM  ( n -- n+1 )        DUP 1+ SWAP CONSTANT ;

\ INITIALIZE CARD DECK
  : (INIT) ( ADDR -- )   COUNT 0 DO  I C!+  LOOP DROP ;

TRUE VALUE FUZZY?

\ MAKE STRING FUZZY
  : FUZZY ( addr c -- )
    DUP 1 > FUZZY? AND IF
         254 and                \ force even count
         0 DO
           100 CHOOSE 25 < IF DUP DUP CHAR+ CEXCH THEN
           CHAR+ CHAR+          \ correction here: added CHAR+
          2 +LOOP DROP
    ELSE 2DROP THEN ;

\ FUZZY THE SHUFFLE ORDER  
  : FUZZY-SWAP ( addr1 addr2 -- addr1 addr2 | addr2 addr1 )
    FUZZY? IF 100 CHOOSE 50 < IF SWAP THEN
           ELSE SWAP THEN ;

\ SHUFFLE CARD DECK
  : (SHUFFLE) ( c-addr -- )
     COUNT 2>R
      2R@ + CHAR- 2R@ 2/ DUP >R + CHAR-
      FUZZY-SWAP R> 0 DO    \ replaced SWAP with FUZZY-SWAP
      2DUP 2>R C@ SWAP C@
      R> CHAR- R> CHAR- SWAP
     LOOP 2DROP
     2R@ 0 DO  SWAP C!+  LOOP DROP
     2R> FUZZY
   ;

\ SHOW CARDS IN DECK
\ mhx: last card is always 51
  : (SHOW)    ( addr -- )
    COUNT 0 DO I 8 MOD 0= IF CR THEN C@+ 4 .R LOOP DROP
  ;    

\ OPCODES
0 ENUM FIZIX
  ENUM INIT
  ENUM SHUFFLE1
  ENUM SHOW
DROP  

\ CARD DECK DEFINING WORD
  : DECK:
    CREATE ( n "ccc" --)  \ N=number of cards in deck
    DUP C, ALLOT
    DOES>  ( N --??)                 \ N=opcode
    SWAP CASE
      FIZIX    OF COUNT     ENDOF    \  deck address and count
      INIT     OF (INIT)    ENDOF    \  INIT    deck
      SHUFFLE1 OF (SHUFFLE) ENDOF    \  SHUFFLE deck
      SHOW     OF (SHOW)    ENDOF    \  SHOW    deck
    NIP CR ." (?) Are you INSANE "
    ENDCASE
  ;

TRUE [IF] CR .( CARDS ...)
52 DECK: AA           \ Define card deck
FIZIX    AA . .       \ Deck physics

: FOO ( N --)
        0 DO SHUFFLE1 AA LOOP SHOW AA ;

INIT     AA           \ Initialize it
SHOW     AA           \ Show it
FALSE TO FUZZY?       \ Disable the fuzz
8 FOO                 \ 8 perfect shuffles restores order
TRUE TO FUZZY?        \ Enable the fuzz
8 FOO      
: SHUFFLE2  TRUE TO FUZZY?  INIT AA 8 0 DO SHUFFLE1 AA LOOP ;
[THEN]

: .SPEED2 ( -- )
        TRUE TO FUZZY?
        CR TIMER-RESET #1000 0 DO  SHUFFLE2  LOOP
        MS? . ." microseconds per shuffle2" ;

\ -- Wil Baden --------------------------------------------------------------------------- -------
\ The most efficient one. Five times faster than Zegub's.
: SHUFFLE3  ( -- )
        #52 0 DO  I  deck I + C!  LOOP
        #52 0 DO  deck I +  deck #52 CHOOSE +  CEXCH LOOP ;

: .SPEED3 ( -- )
        CR TIMER-RESET #1000 0 DO  SHUFFLE3  LOOP
        MS? . ." microseconds per shuffle3" ;

\ -- Ewald Pfau --------------------------------------------------------------------------- ------
\ Thrice slower than Baden's
: SHUFFLE4  ( -- )
   deck 52 ERASE
   deck 52
   0 DO i 1+ CHOOSE                ( a r)
        2dup i swap SCAN
        dup 0=                     ( a r a+ i- f)
           IF  2drop over          ( a r a)
               dup 1+ i MOVE       ( a r)
               over c!             ( a)
         ELSE  1 /STRING over swap ( a r a+ a+ i-)
               over 1+ swap MOVE   ( a r a+)
               I swap c! drop      ( a)
        ENDIF
   LOOP drop ;

: .SPEED4 ( -- )
        CR TIMER-RESET #1000 0 DO  SHUFFLE4  LOOP
        MS? . ." microseconds per shuffle4" ;