1 ! :folding=indent:collapseFolds=0:
5 ! Copyright (C) 2003, 2004 Slava Pestov.
7 ! Redistribution and use in source and binary forms, with or without
8 ! modification, are permitted provided that the following conditions are met:
10 ! 1. Redistributions of source code must retain the above copyright notice,
11 ! this list of conditions and the following disclaimer.
13 ! 2. Redistributions in binary form must reproduce the above copyright notice,
14 ! this list of conditions and the following disclaimer in the documentation
15 ! and/or other materials provided with the distribution.
17 ! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
18 ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
19 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
20 ! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
21 ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
22 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
23 ! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
24 ! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
25 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
26 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
35 : random-digit ( -- digit )
38 : random-symmetric-int ( max -- random )
39 #! Return a random integer between -max and max.
40 dup neg swap random-int ;
42 : chance ( n -- boolean )
43 #! Returns true with a 1/n probability, false with a (n-1)/n
45 1 swap random-int 1 = ;
47 : random-element ( list -- random )
48 #! Returns a random element from the given list.
49 dup >r length pred 0 swap random-int r> nth ;
51 : random-subset ( list -- list )
52 #! Returns a random subset of the given list. Each item is
55 [ drop random-boolean ] subset ;
57 : car+ ( list -- sum )
58 #! Adds the car of each element of the given list.
59 0 swap [ car + ] each ;
61 : random-probability ( list -- sum )
62 #! Adds the car of each element of the given list, and
63 #! returns a random number between 1 and this sum.
64 1 swap car+ random-int ;
66 : random-element-iter ( list index -- elem )
67 #! Used by random-element*. Do not call directly.
68 [ unswons unswons ] dip ( list elem probability index )
69 swap - ( list elem index )
73 nip random-element-iter
76 : random-element* ( list -- elem )
77 #! Returns a random element of the given list of comma
78 #! pairs. The car of each pair is a probability, the cdr is
79 #! the item itself. Only the cdr of the comma pair is
81 dup 1 swap car+ random-int random-element-iter ;
83 : random-subset* ( list -- list )
84 #! Returns a random subset of the given list of comma pairs.
85 #! The car of each pair is a probability, the cdr is the
86 #! item itself. Only the cdr of the comma pair is returned.
87 dup [ [ [ ] ] dip car+ ] dip ( [ ] probabilitySum list )
89 [ 1 over random-int ] dip ( [ ] probabilitySum probability elem )
90 uncons ( [ ] probabilitySum probability elema elemd )
91 -rot ( [ ] probabilitySum elemd probability elema )
92 > ( [ ] probabilitySum elemd boolean )
96 -rot ( elemd [ ] probabilitySum )
97 [ cons ] dip ( [ elemd ] probabilitySum )