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