Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Sets in Forth

322 views
Skip to first unread message

Steve Graham

unread,
Feb 7, 2012, 10:25:24 AM2/7/12
to
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

Anton Ertl

unread,
Feb 7, 2012, 10:44:43 AM2/7/12
to
Steve Graham <jsgra...@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/

Steve Graham

unread,
Feb 7, 2012, 11:49:16 AM2/7/12
to
Anton Ertl wrote:
> Steve Graham<jsgra...@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

Marcel Hendrix

unread,
Feb 7, 2012, 3:12:34 PM2/7/12
to
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)~

Paul Rubin

unread,
Feb 7, 2012, 10:24:41 PM2/7/12
to
an...@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.

WJ

unread,
Apr 12, 2013, 1:39:58 PM4/12/13
to
Factor:

USING: random math.ranges ;

20 [1,b] >array randomize .
{ 1 17 10 20 2 6 5 12 18 16 11 15 9 14 19 3 4 13 8 7 }

Sieur de Bienville

unread,
Apr 12, 2013, 4:08:51 PM4/12/13
to
On Feb 7 2012, 10:24 pm, Paul Rubin <no.em...@nospam.invalid> wrote:
> 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.

For n = 24 you also need an RNG with a period of at least 2^80.
Otherwise, you won't generate every possible permutation. That
may or may not be hard to detect, depending on what you're
doing.

Virtually,
Michael Morris

WJ

unread,
Jun 14, 2013, 4:01:32 PM6/14/13
to
Ruby:

(1..18).to_a.shuffle
==>[4, 3, 11, 6, 12, 15, 16, 8, 7, 13, 9, 14, 2, 1, 5, 18, 10, 17]


WJ

unread,
Mar 23, 2015, 1:25:16 AM3/23/15
to
Oforth:

func: randomSeq(n)
{| pool result |
seq(n) asListBuffer -> pool
ListBuffer new -> result
while ( pool isEmpty not ) [
result add( pool removeAt( pool size rand ) ) ]
result dup freeze }

randomSeq(20) println
===>
[10, 5, 7, 13, 12, 18, 14, 20, 4, 17, 6, 19, 16, 9, 15, 8, 1, 11, 2, 3]

WJ

unread,
Feb 9, 2016, 2:49:53 PM2/9/16
to
OFORTH version V0.9.23.1:

: random-seq(n)
seq(n) map(#[Float rand [,]])
sortBy(#last) map(#first) ;

random-seq(20) .

[16, 19, 7, 15, 1, 10, 6, 18, 20, 11, 4, 8, 5, 17, 13, 14, 3, 9, 12, 2]

--
Government is not reason, it is not eloquence, it is force; like fire, a
troublesome servant and a fearful master. Never for a moment should it be left
to irresponsible action. --- George Washington, speech of January 7, 1790
Use this [sword] for me, if I rule well; if not, against me. --- Trajan

lehs

unread,
Feb 9, 2016, 3:57:32 PM2/9/16
to

dunno

unread,
Feb 13, 2016, 5:20:53 AM2/13/16
to
I cannot see original message because it was posted too long ago. Maybe
someone already stated what I'm about to state. The one don't really need
sets or any other data structures to do what is described in original
message. Forth have data stack and there is a way to get value from any
depth, that is, the word ROLL. The one can just put values 1 though 24 on
stack, then get value from random depth, and save it to memory.

I tested following code in js-forth. Word RANDOM get value N from top of
stack and put random value 0..N-1 on top of stack. Almost every Forth have
similar word.

create chosen 24 allot
: init 25 1 do i loop ;
: choose 24 0 do 24 i - random roll chosen i + c! loop ;
init choose

However, since it's a Forth, it might be easier to get rid of memory
writing and just shuffle values on data stack:

: init 25 1 do i loop ;
: shuffle 24 0 do 24 i - random i + roll loop ;
init shuffle

--
dunno

dunno

unread,
Feb 14, 2016, 3:10:08 PM2/14/16
to
WJ <w_a_...@yahoo.com> wrote:
> OFORTH version V0.9.23.1:
>
>> random-seq(n)
> seq(n) map(#[Float rand [,]])
> sortBy(#last) map(#first) ;
>
> random-seq(20) .
>
> [16, 19, 7, 15, 1, 10, 6, 18, 20, 11, 4, 8, 5, 17, 13, 14, 3, 9, 12, 2]

Forth is good with numbers too.

: random-seq { n -- } n 1+ 1 do i loop n 0 do n i - random i + roll loop ;

--
dunno

WJ

unread,
Feb 14, 2016, 4:41:07 PM2/14/16
to
Ruby:

(1..20).to_a.shuffle
===>
[7, 9, 11, 6, 2, 13, 20, 16, 17, 5, 12, 19, 18, 10, 8, 4, 3, 1, 15, 14]


--
The Authoritarian Personality extends beyond the attempt to pathologize
cohesive gentile groups to pathologizing adaptive gentile behavior in general.
The principal intellectual difficulty is that behavior that is critical to
Judaism as a successful group evolutionary strategy is conceptualized as
pathological in gentiles. --- Dr. Kevin MacDonald; "The Frankfurt School of
Social Research and the Pathologization of Gentile Group Allegiances"
0 new messages