home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / library / queuem2 / unifrng.mod < prev    next >
Text File  |  1989-08-02  |  8KB  |  223 lines
  1. (* source: h:\modula\code\random\UnifRNG.MOD    v1.0b       revised: 88.06.16
  2.    author: G.Greene, AGCS D/429 (NS/TS), 312/681-7783       created: 88.06.09
  3.  
  4.    function:
  5.     This is the implementation code for a module which provides generators of
  6.     uniformly-distributed pseudo-random variates.  The primary procedure --
  7.     invoked, directly or indirectly, by all other random number generators --
  8.     provides reals in the half-open interval [0,1).  A specialized variant of
  9.     this generates values in the interval (0, 1), for applications wherein
  10.     zero values are not acceptable.  There are also discrete-uniform, general
  11.     continuous rectangular, and Pareto random number generators.  Procedures
  12.     are provided for reading and setting the random number seed value.
  13.  
  14.    history:
  15.     88.06.09  1.0a  initial release.
  16.     88.06.16  1.0b  added general continuous rectangular distribution.
  17. *)
  18.  
  19. IMPLEMENTATION MODULE UnifRNG;
  20.  
  21.  
  22. FROM SYSTEM    IMPORT (*PROC*) WORD;
  23.  
  24. FROM MATHLIB   IMPORT (*PROC*) Log, Exp;
  25.  
  26.  
  27. VAR
  28.   RandomInteger: LONGINT;
  29.  
  30.  
  31.  
  32. (*  Return as the function value a REAL equivalent of the parameter value,
  33.     which is expected to be a double-word value (such as LONGCARD).
  34. *)
  35.  
  36. PROCEDURE  Convert (
  37.                     Value:  ARRAY  OF WORD ): LONGREAL;
  38.  
  39. BEGIN
  40.   RETURN  LONGREAL ( CARDINAL ( Value [ 1 ] ) ) * 65536.0  +
  41.           LONGREAL ( CARDINAL ( Value [ 0 ] ) );
  42. END  Convert;
  43.  
  44.  
  45.  
  46. (*  Return as the function value a LONGREAL value, uniformly distributed in
  47.     the interval [0,1).
  48. *)
  49.  
  50. PROCEDURE  UniformVariate ( ): LONGREAL;
  51.  
  52. CONST
  53.   MultFactor = 1566083941;
  54.   TwoTo32nd  = 4294967296.0;
  55.  
  56. BEGIN
  57.   RandomInteger := RandomInteger * MultFactor + 1;
  58.   RETURN  Convert ( RandomInteger ) / TwoTo32nd;
  59. END UniformVariate;
  60.  
  61. (*                                                                         [2]
  62.  source: h:\modula\code\random\UnifRNG.MOD    v1.0b       revised: 88.06.16 *)
  63.  
  64.  
  65.  
  66. (*  Since there is a chance, albeit minute, that the standard uniform random-
  67.     number generator will return a zero value, and since a zero value will
  68.     result in an error when used in some applications (particularly other
  69.     random variate generators), we provide this function that is guaranteed
  70.     not to yield a zero value.  Resulting values are in the interval ( 0, 1 ).
  71. *)
  72.  
  73. PROCEDURE  NonzeroUniformVariate ( ): LONGREAL;
  74.  
  75. VAR
  76.   UniformValue: LONGREAL;
  77.  
  78. BEGIN
  79.   REPEAT  (* nearly always once, never more than twice *)
  80.     UniformValue := UniformVariate ( )
  81.   UNTIL  UniformValue > 0.0;
  82.  
  83.   RETURN  UniformValue
  84. END  NonzeroUniformVariate;
  85.  
  86.  
  87.  
  88. (*  Return as the function value a discrete uniform variate in the range
  89.     specified by the parameters.  The parameters are supposed to be the low
  90.     and high ends of the range of possible values, respectively, but the
  91.     range limits can be presented in either order.  (Reversing the order
  92.     results in an inverting of the returned values, but the distribution
  93.     will still be in the proper range, and no less random.)  The maximum
  94.     number of discrete values that can be generated is MaxInt (32767), thus
  95.     the value abs ( HighValue - LowValue + 1 ) must not exceed MaxInt
  96.     (for example, parameters ( -20000, 20000 ) would not be acceptable).
  97.  
  98.     Implementation note:  The value of Range will "normally" be positive
  99.     (i.e., when the parameters are presented in the "proper" order).  Its
  100.     value is number of discrete values that may be generated (an inclusive
  101.     count of the range).  If the parameter order is inverted, Range will be
  102.     negative, but its absolute value will remain the same.  The absolute
  103.     value of UniformVariate ( ) * Range will be in the interval [0, Range).
  104.     The result of the trunc function will be a integer with absolute value
  105.     in the interval [0, Range-1].  This means that for the normal case, the
  106.     interval will be [0, HighValue-LowValue];  for the reverse case, it will
  107.     be [HighValue-LowValue, 0].  We thus have, for the two possible orders
  108.     of parameter, the function range:
  109.  
  110.     normal:   [ LowValue + 0 , LowValue + ( HighValue - LowValue )]  ==
  111.               [ LowValue, HighValue ]
  112.  
  113.     reverse:  [ LowValue + ( HighValue - LowValue ) , LowValue + 0 ] ==
  114.               [ HighValue, LowValue ]
  115. *)
  116.  
  117. (*                                                                         [3]
  118.  source: h:\modula\code\random\UnifRNG.MOD    v1.0b       revised: 88.06.16 *)
  119.  
  120.  
  121. PROCEDURE  DiscreteVariate (
  122.                     (*in*)  LowValue,
  123.                     (*in*)  HighValue: INTEGER ): INTEGER;
  124.  
  125. VAR
  126.   LoReal,
  127.   HiReal,
  128.   Range:  LONGREAL;
  129.  
  130. BEGIN
  131.   LoReal := LONGREAL ( LowValue );
  132.   HiReal := LONGREAL ( HighValue );
  133.  
  134.   IF  HighValue >= LowValue
  135.     THEN  Range := HiReal - LoReal + 1.0;
  136.     ELSE  Range := HiReal - LoReal - 1.0;
  137.   END;
  138.  
  139.   RETURN  LowValue  +  INTEGER ( UniformVariate ( ) * Range );
  140. END  DiscreteVariate;
  141.  
  142.  
  143.  
  144. (*  Return as the function value a general continuous rectangular variate in
  145.     the range specified by the parameters.  The parameters are supposed to be
  146.     the low and high ends of the range of possible values, respectively, but
  147.     the range limits can be presented in either order.  (Reversing the order
  148.     results in an inverting of the returned values, but the distribution will
  149.     be no less random.)  Resulting values are confined to the interval
  150.     [ LowValue, HighValue ) for the case of parameters in normal order, and
  151.     to ( HighValue, LowValue ] for inverted parameters.  This can be used to
  152.     get special cases:  for uniform variates in the interval ( 0, 1 ] invoke
  153.     this procedure as RectangularVariate ( 1.0, 0.0 ).
  154. *)
  155.  
  156. PROCEDURE  RectangularVariate (
  157.                        (*in*)  LowValue,
  158.                        (*in*)  HighValue: REAL ): LONGREAL;
  159.  
  160. BEGIN
  161.   RETURN  LONGREAL ( LowValue )  +
  162.           UniformVariate ( ) * LONGREAL ( HighValue - LowValue );
  163. END  RectangularVariate;
  164.  
  165. (*                                                                         [4]
  166.  source: h:\modula\code\random\UnifRNG.MOD    v1.0b       revised: 88.06.16 *)
  167.  
  168.  
  169. (*  Return as the function value a Pareto variate with strictly positive
  170.     shape parameter specified by the function parameter.  A negative actual
  171.     parameter is taken as its absolute value;  a zero actual parameter is
  172.     taken as 1.  The formula for the Pareto variate is (1/U) ** (1/Shape),
  173.     where U is a (non-zero) uniform variate, and ** is the FORTRAN
  174.     exponentiation operator.
  175. *)
  176.  
  177. PROCEDURE  ParetoVariate (
  178.                   (*in*)  Shape: REAL ): LONGREAL;
  179.  
  180. VAR
  181.   Exponent: LONGREAL;
  182.  
  183. BEGIN
  184.   IF  Shape = 0.0
  185.     THEN  Exponent := 1.0
  186.     ELSE  Exponent := LONGREAL ( 1.0 / ABS ( Shape ) );
  187.   END;
  188.  
  189.   RETURN  Exp ( Log ( 1.0 / LONGREAL ( NonzeroUniformVariate ( ) ) ) * Exponent )
  190. END  ParetoVariate;
  191.  
  192.  
  193.  
  194. (*  Set the initial value of the seed to use for generating random variates.
  195. *)
  196.  
  197. PROCEDURE  SetSeedValue (
  198.                  (*in*)  ValueToSet: LONGCARD );
  199.  
  200. BEGIN
  201.   RandomInteger := ValueToSet
  202. END  SetSeedValue;
  203.  
  204.  
  205.  
  206. (*  Get the current value of the seed to use for generating random variates.
  207.     This value can be saved to continue a sequence, and later restored using
  208.     the SetSeedValue procedure, above.
  209. *)
  210.  
  211. PROCEDURE  GetSeedValue (
  212.            (*out*)  VAR  CurrentSeed: LONGCARD );
  213.  
  214. BEGIN
  215.   CurrentSeed := RandomInteger
  216. END  GetSeedValue;
  217.  
  218.  
  219.  
  220. BEGIN   (* initialization *)
  221.   RandomInteger := 314159265;
  222. END UnifRNG.
  223.