random.sa


Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
 
------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand        --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------


abstract class $RANDOM_GEN

abstract class $RANDOM_GEN is -- This abstract class is the 'supertype' from which all "raw" random -- number generators subtype. Currently only supports the minimimal standard -- generator. RANDOM uses these subtypes to build more complex random -- numbers. -- Version 1.0 Aug 97. Copyright K Hopper,U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 12 Aug 97 kh Original from 1.1 distrib create : SAME ; init( seed : CARD ) ; -- This routine initialises the generator using seed. Any cardinal value -- should be legal. get : FLTD ; -- This routine returns the next random number in the range zero to one. end ; -- $RANDOM_GEN

class WHITE{GEN < $RANDOM_GEN}

class WHITE{GEN < $RANDOM_GEN} is -- This class represents a random number source, which uses a "raw" -- random number generator stream of type "GEN". -- -- If this is used through a regular variable, which has been created, -- it will act as an individual generator. Otherwise - if the variable is -- void, or routines are called on the class directly - a default generator -- will be used to act as an independant random number generator. -- -- Version 1.1 Dec 2000. Copyright K Hopper,U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 12 Aug 97 kh Original from 1.1 distrib as 'RANDOM' -- 22 Dec 00 kh Removed distributioins and renamed private shared default_gen : GEN ; -- Shared generator private attr own_gen : GEN ; -- Individualized generator private make_generator : GEN is -- This routine ensures that the $RANDOM_GEN creation routine really -- produces an object of class GEN -- otherwise since $RANDOM_GEN::create -- returns a $RANDOM_GEN, there need to be a typecase to make sure that it -- actually is of type GEN (abstract classes cannot return SAME) gen ::= GEN::create ; typecase gen when GEN then return gen else SYS_ERROR::create.error(self,SYS_EXCEPT::Bad_Type, SYS::str_for_tp(SYS::tp(gen))) ; return void -- to keep compiler happy! end end ; gen : GEN is -- This routine is the interface to the generator. If self is void, use -- the shared generator, otherwise use the created generator. if void(self) then if void(default_gen) then default_gen := make_generator end ; return default_gen else return own_gen end end ; create : SAME is -- This routine creates a new stream of random values. me : SAME := new ; me.own_gen := make_generator ; return me end ; seed( new_seed : CARD ) is -- This routine initialises the generator with the new seed value. gen.init(new_seed) end ; int( lower, upper : INT ) : INT pre lower <= upper is -- This routine yields the next random number in the range lower to -- upper inclusive. return (lower + (((upper - lower + 1.int).fltd) * uniform).floor.int) end ; card( lower, upper : CARD ) : CARD pre lower <= upper is -- This routine returns the next non-negative random number in the range -- lower to upper. return (lower + (((upper - lower + 1).fltd) * uniform).floor.card) end ; uniform : FLTD is -- This routine returns the next uniformly distributed random number in -- the range 0.0 to 1.0 return gen.get end ; uniform_range( lower, upper : FLTD ) : FLTD pre lower <= upper is -- This routine returns the next uniformly distributed random number in -- the range lower to upper. return lower + (upper - lower) * uniform end ; bit( probability : FLTD ) : BOOL pre (probability >= 0.0d) and (probability <= 1.0d) is -- This routine returns the value true with the given probability. return (uniform < probability) end ; end ; -- WHITE

class WHITE_GEN < $RANDOM_GEN

class WHITE_GEN < $RANDOM_GEN is -- This class implements a white noise generator over the range zero to -- one. It is therefore the "minimal standard" generator described in -- "Random Number Generators: Good Ones are Hard to Find" by Stephen Park and -- Keith Miller, Communications of the ACM, October 1988, Volume 31, Number -- 10, p. 1192. -- Any seed value in the range `[1,2147483646]' is equally good. -- Version 1.2 Dec 2000. Copyright K Hopper,U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 12 Aug 95 bg Original as MS_RANDOM_GEN -- 12 Aug 97 kh Modified for portability -- 22 Dec 00 kh Renamed for Required Library private const ms_a : FLTD := 16807.0d ; private const Def_Seed : CARD := 42 ; -- must not be zero!!!!! -- The following two are shared for intialisation at run-time due to -- problems with constant initialisation order! private shared ms_m : FLTD ; private shared ms_md : FLTD ; readonly attr seed : CARD ; -- Current state of generator. create : SAME is -- This routine produces a generator with a default seed. me : SAME := new ; me.init(42) ; return me end ; init( nseed : CARD ) is -- This routine initialises the generator. seed := 1 + (nseed - 1).mod(2147483645) ; ms_m := NUM_BITS::create.alter(31,setbit).card.fltd - 1.0d ; ms_md := ms_m - 1.0d end ; get : FLTD is -- This routine returns a pseudo-random number in the range zero to one, -- excluding the value 1.0. tmp : FLTD := ms_a * (seed.fltd) ; seed:=(tmp - (ms_m * ((tmp/ms_m).floor))).floor.card ; return(((seed - 1).fltd)/ms_md) end ; end ; -- WHITE_GEN

class RANDOM

class RANDOM is -- This class implements the standard random number abstraction using -- a minimal standard white noise random number generator. -- Version 1.1 Dec 2000. Copyright K Hopper,U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 14 Aug 97 kh Original from 1.1 distrib -- 22 Dec 00 kh now using white noise default include WHITE{WHITE_GEN} ; end ; -- RANDOM