Steve Graham <
jsgra...@yahoo.com> writes Re: Sets in Forth
> Part of a recent project was to generate the numbers 1-24 in random
> order. One tack is to:
> 1) Initialize an "array" of 24 bytes to 0
> 2) For each of 24 times
> a) Get a random number between 0 and
> (the number of possible numbers - 1)
> b) Look at the array of available numbers using this position number
> c) If the number in that position is already chosen, go back to a)
> d) Otherwise,
> i) Mark the number as chosen
> ii) Move it to an array of chosen numbers
[..]
> Is there another or better way?
At least I can show you the results of past CLF discussions (a very
distant past, I'm afraid). Anton's description fits Wil Baden's code,
I think.
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" ;
CR .( *** Card shuffle algorithms *** )
CR .~ Try: .SPEED (Floyd's Algorithm F2) .SPEED2 (Zegub) .SPEED3 (Baden) .SPEED4 (Pfau)~