Power-Programmierung/CD1.mdf/ada/setl2/samples/random.stl

Text File | 1991-11-16 | 4KB | 155 lines

--
--  RANDOM NUMBERS
--  ==============
--
--  This package is meant to replace the "random" built-in procedure in
--  SETL.  It is somewhat different conceptually from that procedure.
--
--  We allow the creation and access of `streams' of random numbers.  To
--  create a stream, call start_random passing it some kind of source and
--  an initial seed.  The source should be one of the following:
--
--     1.  An integer.  In this case we return integers from 1 to that
--         integer.
--
--     2.  A real.  We return reals from 0.0 to that real.
--
--     3.  A set.  We return random elements from that set.
--
--     4.  A tuple.  We return random elements from that tuple.
--
--  The seed may be an integer, or om.  If it is om we use the time as
--  the initial seed.
--

package Random_Numbers;

   procedure Start_Random(Source,Seed);

   procedure Random(Handle);

end Random_Numbers;

package body Random_Numbers;

   const  Modulus      := 2 ** 64 - 59,
          Multiplier   := 2 ** 60 - 93,
          Increment    := 2 ** 15 - 19;

   var    Stream_Set   := {},
          Source_Map   := {},
          Seed_Map     := {};

   --
   --  Start_Random
   --  ------------
   --
   --  This procedure is called to initialize a stream of random numbers.
   --  It returns a handle which is used to access the stream.
   --

   procedure Start_Random(Source,Seed);

      var Handle;

      --
      --  Allocate a handle for this stream.
      --

      Handle := newat();
      Stream_Set with := Handle;

      --
      --  Set the initial seed.  If we get one from the caller, use that.
      --  Otherwise use the time.
      --

      if Seed = om then

         t := Time();
         Seed_Map(Handle) := unstr(t(1 .. 2)) * 60 ** 2 +
                             unstr(t(4 .. 5)) * 60 +
                             unstr(t(7 ..));

      elseif not is_integer(Seed) then

         print("Invalid seed in Start_Random => ",seed);
         stop;

      else

         Seed_Map(Handle) := Seed;

      end if;

      --
      --  Save the source in a map.
      --

      case type(Source)

         when "INTEGER", "REAL", "TUPLE" =>

            Source_Map(Handle) := Source;

         when "SET" =>

            Source_Map(Handle) := [x : x in Source];

         otherwise =>

            print("Invalid source in Start_Random => ", Source);
            stop;

      end case;

      return Handle;

   end Start_Random;

   --
   --  Random
   --  ------
   --
   --  This procedure returns a single random number (or element from set
   --  or tuple).
   --

   procedure Random(Handle);

      --
      --  Validate the handle.
      --

      if Handle notin Stream_Set then

         print("Invalid handle for Random");
         stop;

      end if;

      --
      --  Find a random integer (linear congruential method).
      --

      New_Seed := (Seed_Map(Handle) * Multiplier + Increment) mod Modulus;
      Seed_Map(Handle) := New_Seed;
      Source := Source_Map(Handle);

      --
      --  Return the random number.
      --

      return case type(Source)
         when "INTEGER" =>
            (New_Seed mod Source_Map(Handle)) + 1
         when "REAL" =>
            float(New_Seed) / float(Modulus) * Source_Map(Handle)
         when "TUPLE" =>
            Source((New_Seed mod #Source) + 1)
      end case;

   end Random;

end Random_Numbers;