Re: Sets in Forth

From	mhx@iae.nl (Marcel Hendrix)
Subject	Re: Sets in Forth
Newsgroups	comp.lang.forth
Message-ID	<69911396018435@frunobulax.edu> (permalink)
Date	2012-02-07 22:12 +0200
References	<jgrfp0$m45$1@speranza.aioe.org>
Organization	Wanadoo

Show all headers | View raw

Steve Graham <jsgrahamus@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)~

Back to comp.lang.forth | Previous | Next — Previous in thread | Find similar

Thread

Sets in Forth Steve Graham <jsgrahamus@yahoo.com> - 2012-02-07 08:25 -0700
  Re: Sets in Forth anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2012-02-07 15:44 +0000
    Re: Sets in Forth Steve Graham <jsgrahamus@yahoo.com> - 2012-02-07 09:49 -0700
    Re: Sets in Forth Paul Rubin <no.email@nospam.invalid> - 2012-02-07 19:24 -0800
  Re: Sets in Forth mhx@iae.nl (Marcel Hendrix) - 2012-02-07 22:12 +0200

csiph-web