gcc/m2/gm2-libs-iso/RandomNumber.mod

   1 (* RandomNumber.mod implement a set of random number procedures for pervasive types.
   2
   3 Copyright (C) 2012-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE RandomNumber ;
  28
  29
  30 FROM libc IMPORT rand, srand ;
  31 FROM Selective IMPORT Timeval, InitTime, KillTime, GetTime, GetTimeOfDay ;
  32
  33
  34 (*
  35    Randomize - initialize the random number generator with a seed
  36                based on the microseconds.
  37 *)
  38
  39 PROCEDURE Randomize ;
  40 VAR
  41    t        : Timeval ;
  42    sec, usec: CARDINAL ;
  43 BEGIN
  44    t := InitTime(0, 0) ;
  45    IF GetTimeOfDay(t)=0
  46    THEN
  47    END ;
  48    GetTime(t, sec, usec) ;
  49    RandomInit(usec) ;
  50    t := KillTime(t)
  51 END Randomize ;
  52
  53
  54 (*
  55    RandomInit - initialize the random number generator with value, seed.
  56 *)
  57
  58 PROCEDURE RandomInit (seed: CARDINAL) ;
  59 BEGIN
  60    srand(seed)
  61 END RandomInit ;
  62
  63
  64 (*
  65    RandomBytes - fills in an array with random values.
  66 *)
  67
  68 PROCEDURE RandomBytes (VAR a: ARRAY OF BYTE) ;
  69 VAR
  70    i, h: CARDINAL ;
  71 BEGIN
  72    h := HIGH(a) ;
  73    i := 0 ;
  74    WHILE i<=h DO
  75       a[i] := VAL(BYTE, rand()) ;
  76       INC(i)
  77    END
  78 END RandomBytes ;
  79
  80
  81 (*
  82    RandomInt - return an INTEGER in the range [low .. high].
  83 *)
  84
  85 PROCEDURE RandomInt (low, high: INTEGER) : INTEGER ;
  86 BEGIN
  87    RETURN VAL(INTEGER, RandomLongInt(low, high))
  88 END RandomInt ;
  89
  90
  91 (*
  92    RandomShortInt - return an SHORTINT in the range [low..high].
  93 *)
  94
  95 PROCEDURE RandomShortInt (low, high: SHORTINT) : SHORTINT ;
  96 BEGIN
  97    RETURN VAL(SHORTINT, RandomInt(low, high))
  98 END RandomShortInt ;
  99
 100
 101 (*
 102    RandomLongInt - return an LONGINT in the range [low..high].
 103 *)
 104
 105 PROCEDURE RandomLongInt (low, high: LONGINT) : LONGINT ;
 106 VAR
 107    random: LONGINT ;
 108    values,
 109    number: LONGCARD ;
 110 BEGIN
 111    RandomBytes(number) ;
 112    IF (low=0) AND (high=0)
 113    THEN
 114       RETURN number
 115    ELSE
 116       values := high-low;
 117       random := number MOD (values+1) ;
 118       RETURN random+low
 119    END
 120 END RandomLongInt ;
 121
 122
 123 (*
 124    RandomLongCard - return an LONGCARD in the range [low..high].
 125 *)
 126
 127 PROCEDURE RandomLongCard (low, high: LONGCARD) : LONGCARD ;
 128 VAR
 129    random,
 130    values,
 131    number: LONGCARD ;
 132 BEGIN
 133    RandomBytes(number) ;
 134    IF (low=0) AND (high=0)
 135    THEN
 136       RETURN number
 137    ELSE
 138       values := high-low;
 139       random := number MOD (values+1) ;
 140       RETURN random+low
 141    END
 142 END RandomLongCard ;
 143
 144
 145 (*
 146    RandomCard - return a CARDINAL in the range [low..high].
 147 *)
 148
 149 PROCEDURE RandomCard (low, high: CARDINAL) : CARDINAL ;
 150 BEGIN
 151    RETURN RandomLongCard(low, high)
 152 END RandomCard ;
 153
 154
 155 (*
 156    RandomShortCard - return a SHORTCARD in the range [low..high].
 157 *)
 158
 159 PROCEDURE RandomShortCard (low, high: CARDINAL) : CARDINAL ;
 160 BEGIN
 161    RETURN RandomLongCard(low, high)
 162 END RandomShortCard ;
 163
 164
 165 (*
 166    RandomReal - return a REAL number in the range 0.0..1.0
 167 *)
 168
 169 PROCEDURE RandomReal () : REAL ;
 170 BEGIN
 171    RETURN RandomLongReal()
 172 END RandomReal ;
 173
 174
 175 (*
 176    RandomLongReal - return a LONGREAL number in the range 0.0..1.0
 177 *)
 178
 179 PROCEDURE RandomLongReal () : LONGREAL ;
 180 VAR
 181    l: LONGCARD ;
 182 BEGIN
 183    RandomBytes(l) ;
 184    RETURN VAL(LONGREAL, l)/VAL(LONGREAL, MAX(LONGCARD))
 185 END RandomLongReal ;
 186
 187
 188 (*
 189    RandomShortReal - return a SHORTREAL number in the range 0.0..1.0
 190 *)
 191
 192 PROCEDURE RandomShortReal () : SHORTREAL ;
 193 BEGIN
 194    RETURN RandomLongReal()
 195 END RandomShortReal ;
 196
 197
 198 BEGIN
 199    Randomize
 200 END RandomNumber.