1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- G N A T . R A N D O M _ N U M B E R S --
9 -- Copyright (C) 2007-2009 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada.Numerics.Long_Elementary_Functions;
33 use Ada.Numerics.Long_Elementary_Functions;
34 with Ada.Unchecked_Conversion;
35 with System.Random_Numbers; use System.Random_Numbers;
37 package body GNAT.Random_Numbers is
39 Sys_Max_Image_Width : constant := System.Random_Numbers.Max_Image_Width;
41 subtype Image_String is String (1 .. Max_Image_Width);
43 -- Utility function declarations
45 procedure Insert_Image
46 (S : in out Image_String;
49 -- Insert string representation of V in S starting at position Index
56 new Ada.Unchecked_Conversion (Unsigned_32, Integer_32);
58 new Ada.Unchecked_Conversion (Unsigned_64, Integer_64);
64 procedure Insert_Image
65 (S : in out Image_String;
69 Image : constant String := Integer_64'Image (V);
71 S (Index .. Index + Image'Length - 1) := Image;
78 function Random_Discrete
80 Min : Result_Subtype := Default_Min;
81 Max : Result_Subtype := Result_Subtype'Last) return Result_Subtype
84 new System.Random_Numbers.Random_Discrete
85 (Result_Subtype, Default_Min);
87 return F (Gen.Rep, Min, Max);
94 function Random (Gen : Generator) return Float is
96 return Random (Gen.Rep);
99 function Random (Gen : Generator) return Long_Float is
101 return Random (Gen.Rep);
104 function Random (Gen : Generator) return Interfaces.Unsigned_32 is
106 return Random (Gen.Rep);
109 function Random (Gen : Generator) return Interfaces.Unsigned_64 is
111 return Random (Gen.Rep);
114 function Random (Gen : Generator) return Integer_64 is
116 return To_Signed (Unsigned_64'(Random (Gen)));
119 function Random (Gen : Generator) return Integer_32 is
121 return To_Signed (Unsigned_32'(Random (Gen)));
124 function Random (Gen : Generator) return Long_Integer is
125 function Random_Long_Integer is new Random_Discrete (Long_Integer);
127 return Random_Long_Integer (Gen);
130 function Random (Gen : Generator) return Integer is
131 function Random_Integer is new Random_Discrete (Integer);
133 return Random_Integer (Gen);
140 function Random_Float (Gen : Generator) return Result_Subtype is
141 function F is new System.Random_Numbers.Random_Float (Result_Subtype);
146 ---------------------
147 -- Random_Gaussian --
148 ---------------------
150 -- Generates pairs of normally distributed values using the polar method of
151 -- G. E. P. Box, M. E. Muller, and G. Marsaglia. See Donald E. Knuth, The
152 -- Art of Computer Programming, Vol 2: Seminumerical Algorithms, section
153 -- 3.4.1, subsection C, algorithm P. Returns half of the pair on each call,
154 -- using the Next_Gaussian field of Gen to hold the second member on
155 -- even-numbered calls.
157 function Random_Gaussian (Gen : Generator) return Long_Float is
158 G : Generator renames Gen'Unrestricted_Access.all;
160 V1, V2, Rad2, Mult : Long_Float;
163 if G.Have_Gaussian then
164 G.Have_Gaussian := False;
165 return G.Next_Gaussian;
169 V1 := 2.0 * Random (G) - 1.0;
170 V2 := 2.0 * Random (G) - 1.0;
171 Rad2 := V1 ** 2 + V2 ** 2;
172 exit when Rad2 < 1.0 and then Rad2 /= 0.0;
175 -- Now V1 and V2 are coordinates in the unit circle
177 Mult := Sqrt (-2.0 * Log (Rad2) / Rad2);
178 G.Next_Gaussian := V2 * Mult;
179 G.Have_Gaussian := True;
180 return Long_Float'Machine (V1 * Mult);
184 function Random_Gaussian (Gen : Generator) return Float is
185 V : constant Long_Float := Random_Gaussian (Gen);
187 return Float'Machine (Float (V));
194 procedure Reset (Gen : out Generator) is
197 Gen.Have_Gaussian := False;
201 (Gen : out Generator;
202 Initiator : Initialization_Vector)
205 Reset (Gen.Rep, Initiator);
206 Gen.Have_Gaussian := False;
210 (Gen : out Generator;
211 Initiator : Interfaces.Integer_32)
214 Reset (Gen.Rep, Initiator);
215 Gen.Have_Gaussian := False;
219 (Gen : out Generator;
220 Initiator : Interfaces.Unsigned_32)
223 Reset (Gen.Rep, Initiator);
224 Gen.Have_Gaussian := False;
228 (Gen : out Generator;
232 Reset (Gen.Rep, Initiator);
233 Gen.Have_Gaussian := False;
237 (Gen : out Generator;
238 From_State : Generator)
241 Reset (Gen.Rep, From_State.Rep);
242 Gen.Have_Gaussian := From_State.Have_Gaussian;
243 Gen.Next_Gaussian := From_State.Next_Gaussian;
246 Frac_Scale : constant Long_Float :=
248 (Long_Float'Machine_Radix) ** Long_Float'Machine_Mantissa;
250 function Val64 (Image : String) return Integer_64;
251 -- Renames Integer64'Value
252 -- We cannot use a 'renames Integer64'Value' since for some strange
253 -- reason, this requires a dependency on s-auxdec.ads which not all
254 -- run-times support ???
256 function Val64 (Image : String) return Integer_64 is
258 return Integer_64'Value (Image);
262 (Gen : out Generator;
265 F0 : constant Integer := From_Image'First;
266 T0 : constant Integer := From_Image'First + Sys_Max_Image_Width;
269 Reset (Gen.Rep, From_Image (F0 .. F0 + Sys_Max_Image_Width));
271 if From_Image (T0 + 1) = '1' then
272 Gen.Have_Gaussian := True;
274 Long_Float (Val64 (From_Image (T0 + 3 .. T0 + 23))) / Frac_Scale
275 * Long_Float (Long_Float'Machine_Radix)
276 ** Integer (Val64 (From_Image (T0 + 25 .. From_Image'Last)));
278 Gen.Have_Gaussian := False;
286 function Image (Gen : Generator) return String is
287 Result : Image_String;
290 Result := (others => ' ');
291 Result (1 .. Sys_Max_Image_Width) := Image (Gen.Rep);
293 if Gen.Have_Gaussian then
294 Result (Sys_Max_Image_Width + 2) := '1';
295 Insert_Image (Result, Sys_Max_Image_Width + 4,
296 Integer_64 (Long_Float'Fraction (Gen.Next_Gaussian)
298 Insert_Image (Result, Sys_Max_Image_Width + 24,
299 Integer_64 (Long_Float'Exponent (Gen.Next_Gaussian)));
302 Result (Sys_Max_Image_Width + 2) := '0';
308 end GNAT.Random_Numbers;