home *** CD-ROM | disk | FTP | other *** search
/ Chip 1995 March / CHIP3.mdf / programm / prog4 / random.ada < prev    next >
Encoding:
Text File  |  1991-07-01  |  3.6 KB  |  110 lines
  1.                                      -- Chapter 31 - Program 1
  2. -- This is a generic package to generate random numbers in the
  3. --  range of 0.00000 to just less than 1.00000 with as many
  4. --  significant digits as the type FLOAT_ITEM.  This package uses
  5. --  the Linear Congruential Method of random number generation as
  6. --  discussed in "The Art of Computer Programming" volume 2 by
  7. --  Donald Knuth.  The method used follows;
  8. --
  9. --  X(n + 1) = (A * X(n) + C) mod M
  10. --
  11. --  X(n + 1) is the new random number
  12. --  X(n)     is the previous random number or the seed
  13. --  M        is 1.0 for the floating point system
  14. --  A        is 7.0 for the floating point system
  15. --  C        is 13.0 / 31.0 for the floating point system
  16. --  X(0)     is zero by default
  17. --  X(0)     is the number provided if forced with Force_Seed
  18. --  X(0)     is generated as follows when Set_Seed is called;
  19. --        1.   The real time clock is read from the system
  20. --        2.   The hours and minutes are stripped off
  21. --        3.   The resulting number of seconds are divided by
  22. --              60.0 to get the fraction of a minute that has
  23. --              elapsed since midnight
  24.  
  25. generic
  26.    type FLOAT_ITEM is digits <>;
  27. package Random is
  28.  
  29.         -- This procedure uses the system clock to set the seed.
  30.    procedure Set_Seed;
  31.  
  32.         -- This procedure sets the seed to the input value.
  33.    procedure Force_Seed(Start_Seed : FLOAT_ITEM);
  34.  
  35.         -- This Function returns the current seed which is also
  36.         --  the value of the previous random number returned.
  37.    function Get_Seed return FLOAT_ITEM;
  38.  
  39.         -- This function returns a random number from 0.0 to 1.0
  40.    function Random_Number return FLOAT_ITEM;
  41.  
  42. end Random;
  43.  
  44.  
  45.  
  46.  
  47. with Text_IO, Calendar;
  48. use Text_IO, Calendar;
  49. package body Random is
  50.  
  51. X_initial : FLOAT_ITEM := 0.0;
  52. M         : FLOAT_ITEM := 1.0;
  53. A         : FLOAT_ITEM := 7.0;
  54. C         : FLOAT_ITEM := 13.0/31.0;
  55.  
  56.  
  57. procedure Set_Seed is
  58.    Time_And_Date    : TIME;
  59.    All_Day          : DAY_DURATION;
  60.    Minutes          : FLOAT_ITEM;
  61.    Int_Minutes      : INTEGER;
  62.    Part_Of_A_Minute : FLOAT_ITEM;
  63. begin
  64.    Time_And_Date := Clock;                -- Get the time and date
  65.    All_Day := Seconds(Time_And_Date);     -- Seconds since midnight
  66.    Minutes := FLOAT_ITEM(All_Day)/60.0;   -- Floating type Minutes
  67.    Int_Minutes := INTEGER(Minutes - 0.5); -- Integer type minutes
  68.    Part_Of_A_Minute := FLOAT_ITEM(All_Day)
  69.                                - 60.0 * FLOAT_ITEM(Int_Minutes);
  70.    X_Initial := Part_Of_A_Minute / 60.0;
  71. end Set_Seed;
  72.  
  73.  
  74. procedure Force_Seed(Start_Seed : FLOAT_ITEM) is
  75. Temp : FLOAT_ITEM;
  76. Natural_Temp : NATURAL;
  77. begin
  78.    Natural_Temp := NATURAL(Start_Seed - 0.5); -- Subtract 0.5 because
  79.                                               -- the type conversion
  80.                                               -- rounds the result.
  81.    Temp := Start_Seed - FLOAT_ITEM(Natural_Temp);
  82.    X_Initial := Start_Seed;
  83. exception
  84.    when Constraint_Error =>
  85.       Put_Line("Seed out of range, ignored");
  86. end Force_Seed;
  87.  
  88.  
  89. function Get_Seed return FLOAT_ITEM is
  90. begin
  91.    return X_Initial;
  92. end Get_Seed;
  93.  
  94.  
  95. function Random_Number return FLOAT_ITEM is
  96.    Temp         : FLOAT_ITEM;
  97.    Natural_Temp : NATURAL;   -- Cannot exceed (7 + 13/31)
  98. begin
  99.    Temp := A * X_Initial + C;
  100.    Natural_Temp := NATURAL(Temp - 0.5);     -- Subtract 0.5 because
  101.                                             -- the type conversion
  102.                                             -- rounds the result.
  103.    Temp := Temp - FLOAT_ITEM(Natural_Temp);
  104.    X_Initial := Temp;
  105.    return Temp;
  106. end Random_Number;
  107.  
  108. end Random;
  109.  
  110.