home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / LIBRARY / RND.SA < prev    next >
Text File  |  1995-02-05  |  5KB  |  130 lines
  1. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  2. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  3. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  4. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  5. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  6. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  7.    
  8. -- changes 1994/11/03 by Erik Schnetter
  9.    
  10. -- rnd.sa: Random numbers.
  11. -------------------------------------------------------------------
  12. class RND{GEN < $RANDOM_GEN} is
  13.    -- Random numbers.
  14.    
  15.    shared s_gen: GEN;
  16.    attr gen: GEN;
  17.    
  18.    create: SAME is res::=new; res.gen := #GEN; return(res) end;
  19.    
  20.    init is s_gen := #GEN; end;
  21.    
  22.    init(seed: INT) is
  23.       if void(self) then
  24.      if void(s_gen) then init end; s_gen.init(seed)
  25.       else gen.init(seed) end
  26.    end; -- init
  27.    
  28.    int(l,u:INT):INT pre l <= u is 
  29.       return(l+(((u-l+1).fltd)*uniform).floor.int) end;
  30.    
  31.    uniform: FLTD is
  32.       -- A uniformly distributed double in `[0.,1.)'.
  33.       -- Uses default generator if void(self) (as in RND::uniform) else gen.
  34.       if void(self) then 
  35.      if void(s_gen) then init end;
  36.      return(s_gen.get)
  37. --    else return(gen.get) end;                                                 -- NLP
  38.       end; return(gen.get);                                                     -- NLP
  39.    end; -- uniform
  40.    
  41.  
  42. end; -- class RND
  43. -------------------------------------------------------------------
  44. class RND is 
  45.    include RND{MS_RANDOM_GEN};
  46. end;
  47. -------------------------------------------------------------------
  48. type $RANDOM_GEN is
  49.    
  50.    init(seed: INT);
  51.     -- Initialize the generator using nseed. Any `INT' value should be legal.
  52.    
  53.    get:FLTD;
  54.       -- The next random value. Should be in `[0.,1.)'.
  55. end;
  56. -------------------------------------------------------------------   
  57. class MS_RANDOM_GEN < $RANDOM_GEN is
  58.    -- The "minimal standard" generator described in "Random Number
  59.    -- Generators: Good Ones are Hard to Find" by Stephen Park and 
  60.    -- Keith Miller, Communications of the ACM, October 1988, Volume 
  61.    -- 31, Number 10, p. 1192. Linear congruential, produces a value
  62.    -- in `[0.,1.)' including `0.' but not `1.' Any seed value in
  63.    -- the range `[1,2147483646]' is equally good. 
  64.  
  65.    -- Constants used in generator:
  66.    -- BEWARE!! Problems with order of initialization and 
  67.    -- and double literals
  68. --   const ms_a:FLTD:=16807.0d;    -- `7^5'
  69. --   const ms_m:FLTD:=2147483647.0d; -- `(2^31)-1', prime
  70. --   const ms_md:FLTD:=(ms_m-1.0d); -- to avoid continual recomputation
  71.  
  72.    const ms_a:FLTD:=16807.0d;    -- `7^5'
  73.    shared ms_m:FLTD; -- `(2^31)-1', prime
  74.    shared ms_md:FLTD; -- to avoid continual recomputation
  75.    
  76.    attr seed:INT;            -- Current state of generator.
  77.    
  78.    create:SAME is  
  79.       -- A minimal standard generator with `seed=1'.
  80.       res ::= new;  res.init(1);  return(res) end;
  81.  
  82.    
  83.    init(nseed:INT) is 
  84.       -- Initialize the generator.
  85.       seed:=1+(nseed-1).mod(2147483645); 
  86.       ms_m := (2.pow(31)).fltd-1.0d;
  87.       ms_md := ms_m - 1.0d;
  88.       end;  -- keep in legal range
  89.    
  90.    get:FLTD is
  91.       -- Pseudo-random value in `[0.,1.)' generated by minimal std generator.
  92.       tmp:FLTD:=ms_a*(seed.fltd);
  93.       seed:=(tmp-(ms_m*((tmp/ms_m).floor))).int;
  94.       return(((seed-1).fltd)/ms_md);  end; -- get
  95.  
  96. -- Original version
  97. --      tmp:FLTD:=ms_a*(seed);
  98. --      seed:=(tmp-(ms_m*((tmp/ms_m).int))).int;
  99. --      return(((seed-1))/ms_md);  end; -- get
  100.  
  101. end; -- class MS_RANDOM_GEN
  102. --~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  103. class TEST_RND is
  104.    include TEST;
  105.    
  106.    main is
  107.       -- Should test out the beginning of the sequence at least...
  108.       -- Don't know if these test results are correct. These are just
  109.       -- the current values that are being printed out.
  110.       -- If the test fails, it just indicates that something has
  111.       -- changed in double/int arithmetic, not necc. an error
  112.       class_name("RND");
  113.       r ::= RND::uniform;
  114.       test("random 1 See comment about errors",r.str,"0.999992");
  115.       r := RND::uniform;
  116.       test("random 2 See comment about errors",r.str,"0.868462");
  117.       res ::= "";
  118.       loop 
  119.      15.times!;
  120.      res := res+(RND::uniform).str+" ";
  121.      end;
  122.       unchecked_test("Random numbers",res,"0.244397 0.575954 0.0630371 0.464864 0.97356 0.627308 0.166989 0.585985 0.652986 0.734896 0.391713 0.523141 0.433819 0.192019 0.260525 ");
  123.       finish;
  124.       end;
  125.    
  126.      
  127. end; -- class TEST_RND
  128.  
  129. -------------------------------------------------------------------
  130.