Path: csiph.com!x330-a1.tempe.blueboxinc.net!usenet.pasdenom.info!weretis.net!feeder1.news.weretis.net!feeder.erje.net!xlned.com!feeder7.xlned.com!news2.euro.net!postnews2.euro.net!news.wanadoo.nl!not-for-mail From: mhx@iae.nl (Marcel Hendrix) Subject: Re: Sets in Forth Newsgroups: comp.lang.forth Message-ID: <69911396018435@frunobulax.edu> Date: Tue, 7 Feb 2012 22:12:34 +0200 References: X-Newsreader: iForth 2.0 console (October 21, 2006) Lines: 251 Organization: Wanadoo NNTP-Posting-Date: 07 Feb 2012 21:12:27 GMT NNTP-Posting-Host: s529d937f.adsl.wanadoo.nl X-Trace: 1328649147 dr7.euro.net 225 82.157.147.127:51555 X-Complaints-To: abuse@wanadoo.nl Xref: x330-a1.tempe.blueboxinc.net comp.lang.forth:9442 Steve Graham 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)~