library/random.factor

   1 !:folding=indent:collapseFolds=0:
   2
   3 ! $Id$
   4 !
   5 ! Copyright (C) 2003, 2004 Slava Pestov.
   6 !
   7 ! Redistribution and use in source and binary forms, with or without
   8 ! modification, are permitted provided that the following conditions are met:
   9 !
  10 ! 1. Redistributions of source code must retain the above copyright notice,
  11 !    this list of conditions and the following disclaimer.
  12 !
  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.
  16 !
  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.
  27
  28 IN: random
  29 USE: arithmetic
  30 USE: combinators
  31 USE: kernel
  32 USE: lists
  33 USE: stack
  34
  35 : random-digit ( -- digit )
  36     0 9 random-int ;
  37
  38 : random-symmetric-int ( max -- random )
  39     #! Return a random integer between -max and max.
  40     dup neg swap random-int ;
  41
  42 : chance ( n -- boolean )
  43     #! Returns true with a 1/n probability, false with a (n-1)/n
  44     #! probability.
  45     1 swap random-int 1 = ;
  46
  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 ;
  50
  51 : random-subset ( list -- list )
  52     #! Returns a random subset of the given list. Each item is
  53     #! chosen with a 50%
  54     #! probability.
  55     [ drop random-boolean ] subset ;
  56
  57 : car+ ( list -- sum )
  58     #! Adds the car of each element of the given list.
  59     0 swap [ car + ] each ;
  60
  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 ;
  65
  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 )
  70     dup 0 <= [
  71         drop nip
  72     ] [
  73         nip random-element-iter
  74     ] ifte ;
  75
  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
  80     #! returned.
  81     dup 1 swap car+ random-int random-element-iter ;
  82
  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 )
  88     [
  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 )
  93         [
  94             drop
  95         ] [
  96             -rot ( elemd [ ] probabilitySum )
  97             [ cons ] dip ( [ elemd ] probabilitySum )
  98         ] ifte
  99     ] each drop ;