Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #9427 > unrolled thread

Sets in Forth

Started bySteve Graham <jsgrahamus@yahoo.com>
First post2012-02-07 08:25 -0700
Last post2012-02-07 22:12 +0200
Articles 5 — 4 participants

Back to article view | Back to comp.lang.forth

Contents

  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

#9427 — Sets in Forth

FromSteve Graham <jsgrahamus@yahoo.com>
Date2012-02-07 08:25 -0700
SubjectSets in Forth
Message-ID<jgrfp0$m45$1@speranza.aioe.org>
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

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?


Thanks, Steve

[toc] | [next] | [standalone]

#9429

Fromanton@mips.complang.tuwien.ac.at (Anton Ertl)
Date2012-02-07 15:44 +0000
Message-ID<2012Feb7.164443@mips.complang.tuwien.ac.at>
In reply to#9427
Steve Graham <jsgrahamus@yahoo.com> writes:
>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?

A simple array, initialized with numbers 1..24.  Select a random one,
and swap it with the first one.  Select a random one of the remaining
23, and swap it with the next one; repeat until there is only one
remaining number.

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: http://www.forth200x.org/forth200x.html
   EuroForth 2011: http://www.euroforth.org/ef11/

[toc] | [prev] | [next] | [standalone]

#9433

FromSteve Graham <jsgrahamus@yahoo.com>
Date2012-02-07 09:49 -0700
Message-ID<jgrkm7$2ec$1@speranza.aioe.org>
In reply to#9429
Anton Ertl wrote:
> Steve Graham<jsgrahamus@yahoo.com>  writes:
>> 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?
>
> A simple array, initialized with numbers 1..24.  Select a random one,
> and swap it with the first one.  Select a random one of the remaining
> 23, and swap it with the next one; repeat until there is only one
> remaining number.
>
> - anton

Simple solutions, Anton.

Thanks, Steve

[toc] | [prev] | [next] | [standalone]

#9455

FromPaul Rubin <no.email@nospam.invalid>
Date2012-02-07 19:24 -0800
Message-ID<7xehu6qa6e.fsf@ruckus.brouhaha.com>
In reply to#9429
anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
> A simple array, initialized with numbers 1..24.  Select a random one,
> and swap it with the first one.  Select a random one of the remaining
> 23, and swap it with the next one; repeat until there is only one
> remaining number.

You are right about this.  The shuffling code that I posted (in case
anyone was thinking of using it for something) is subtly wrong and can
select permutations with unequal probabilities.  For n=24 the
nonuniformity would probably be hard to detect in practice, however.

[toc] | [prev] | [next] | [standalone]

#9442

Frommhx@iae.nl (Marcel Hendrix)
Date2012-02-07 22:12 +0200
Message-ID<69911396018435@frunobulax.edu>
In reply to#9427
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)~

[toc] | [prev] | [standalone]

Back to top | Article view | comp.lang.forth

csiph-web