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-2015, 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;
36 with System.Random_Numbers; use System.Random_Numbers;
38 package body GNAT.Random_Numbers with
41 Sys_Max_Image_Width : constant := System.Random_Numbers.Max_Image_Width;
43 subtype Image_String is String (1 .. Max_Image_Width);
45 -- Utility function declarations
47 procedure Insert_Image
48 (S : in out Image_String;
51 -- Insert string representation of V in S starting at position Index
58 new Ada.Unchecked_Conversion (Unsigned_32, Integer_32);
60 new Ada.Unchecked_Conversion (Unsigned_64, Integer_64);
66 procedure Insert_Image
67 (S : in out Image_String;
71 Image : constant String := Integer_64'Image (V);
73 S (Index .. Index + Image'Length - 1) := Image;
80 function Random_Discrete
82 Min : Result_Subtype := Default_Min;
83 Max : Result_Subtype := Result_Subtype'Last) return Result_Subtype
86 new System.Random_Numbers.Random_Discrete
87 (Result_Subtype, Default_Min);
89 return F (Gen.Rep, Min, Max);
92 --------------------------
93 -- Random_Decimal_Fixed --
94 --------------------------
96 function Random_Decimal_Fixed
98 Min : Result_Subtype := Default_Min;
99 Max : Result_Subtype := Result_Subtype'Last) return Result_Subtype
101 subtype IntV is Integer_64 range
102 Integer_64'Integer_Value (Min) ..
103 Integer_64'Integer_Value (Max);
104 function R is new Random_Discrete (Integer_64, IntV'First);
106 return Result_Subtype'Fixed_Value (R (Gen, IntV'First, IntV'Last));
107 end Random_Decimal_Fixed;
109 ---------------------------
110 -- Random_Ordinary_Fixed --
111 ---------------------------
113 function Random_Ordinary_Fixed
115 Min : Result_Subtype := Default_Min;
116 Max : Result_Subtype := Result_Subtype'Last) return Result_Subtype
118 subtype IntV is Integer_64 range
119 Integer_64'Integer_Value (Min) ..
120 Integer_64'Integer_Value (Max);
121 function R is new Random_Discrete (Integer_64, IntV'First);
123 return Result_Subtype'Fixed_Value (R (Gen, IntV'First, IntV'Last));
124 end Random_Ordinary_Fixed;
130 function Random (Gen : Generator) return Float is
132 return Random (Gen.Rep);
135 function Random (Gen : Generator) return Long_Float is
137 return Random (Gen.Rep);
140 function Random (Gen : Generator) return Interfaces.Unsigned_32 is
142 return Random (Gen.Rep);
145 function Random (Gen : Generator) return Interfaces.Unsigned_64 is
147 return Random (Gen.Rep);
150 function Random (Gen : Generator) return Integer_64 is
152 return To_Signed (Unsigned_64'(Random (Gen)));
155 function Random (Gen : Generator) return Integer_32 is
157 return To_Signed (Unsigned_32'(Random (Gen)));
160 function Random (Gen : Generator) return Long_Integer is
161 function Random_Long_Integer is new Random_Discrete (Long_Integer);
163 return Random_Long_Integer (Gen);
166 function Random (Gen : Generator) return Integer is
167 function Random_Integer is new Random_Discrete (Integer);
169 return Random_Integer (Gen);
176 function Random_Float (Gen : Generator) return Result_Subtype is
177 function F is new System.Random_Numbers.Random_Float (Result_Subtype);
182 ---------------------
183 -- Random_Gaussian --
184 ---------------------
186 -- Generates pairs of normally distributed values using the polar method of
187 -- G. E. P. Box, M. E. Muller, and G. Marsaglia. See Donald E. Knuth, The
188 -- Art of Computer Programming, Vol 2: Seminumerical Algorithms, section
189 -- 3.4.1, subsection C, algorithm P. Returns half of the pair on each call,
190 -- using the Next_Gaussian field of Gen to hold the second member on
191 -- even-numbered calls.
193 function Random_Gaussian (Gen : Generator) return Long_Float is
194 G : Generator renames Gen'Unrestricted_Access.all;
196 V1, V2, Rad2, Mult : Long_Float;
199 if G.Have_Gaussian then
200 G.Have_Gaussian := False;
201 return G.Next_Gaussian;
205 V1 := 2.0 * Random (G) - 1.0;
206 V2 := 2.0 * Random (G) - 1.0;
207 Rad2 := V1 ** 2 + V2 ** 2;
208 exit when Rad2 < 1.0 and then Rad2 /= 0.0;
211 -- Now V1 and V2 are coordinates in the unit circle
213 Mult := Sqrt (-2.0 * Log (Rad2) / Rad2);
214 G.Next_Gaussian := V2 * Mult;
215 G.Have_Gaussian := True;
216 return Long_Float'Machine (V1 * Mult);
220 function Random_Gaussian (Gen : Generator) return Float is
221 V : constant Long_Float := Random_Gaussian (Gen);
223 return Float'Machine (Float (V));
230 procedure Reset (Gen : out Generator) is
233 Gen.Have_Gaussian := False;
237 (Gen : out Generator;
238 Initiator : Initialization_Vector)
241 Reset (Gen.Rep, Initiator);
242 Gen.Have_Gaussian := False;
246 (Gen : out Generator;
247 Initiator : Interfaces.Integer_32)
250 Reset (Gen.Rep, Initiator);
251 Gen.Have_Gaussian := False;
255 (Gen : out Generator;
256 Initiator : Interfaces.Unsigned_32)
259 Reset (Gen.Rep, Initiator);
260 Gen.Have_Gaussian := False;
264 (Gen : out Generator;
268 Reset (Gen.Rep, Initiator);
269 Gen.Have_Gaussian := False;
273 (Gen : out Generator;
274 From_State : Generator)
277 Reset (Gen.Rep, From_State.Rep);
278 Gen.Have_Gaussian := From_State.Have_Gaussian;
279 Gen.Next_Gaussian := From_State.Next_Gaussian;
282 Frac_Scale : constant Long_Float :=
284 (Long_Float'Machine_Radix) ** Long_Float'Machine_Mantissa;
286 function Val64 (Image : String) return Integer_64;
287 -- Renames Integer64'Value
288 -- We cannot use a 'renames Integer64'Value' since for some strange
289 -- reason, this requires a dependency on s-auxdec.ads which not all
290 -- run-times support ???
292 function Val64 (Image : String) return Integer_64 is
294 return Integer_64'Value (Image);
298 (Gen : out Generator;
301 F0 : constant Integer := From_Image'First;
302 T0 : constant Integer := From_Image'First + Sys_Max_Image_Width;
305 Reset (Gen.Rep, From_Image (F0 .. F0 + Sys_Max_Image_Width));
307 if From_Image (T0 + 1) = '1' then
308 Gen.Have_Gaussian := True;
310 Long_Float (Val64 (From_Image (T0 + 3 .. T0 + 23))) / Frac_Scale
311 * Long_Float (Long_Float'Machine_Radix)
312 ** Integer (Val64 (From_Image (T0 + 25 .. From_Image'Last)));
314 Gen.Have_Gaussian := False;
322 function Image (Gen : Generator) return String is
323 Result : Image_String;
326 Result := (others => ' ');
327 Result (1 .. Sys_Max_Image_Width) := Image (Gen.Rep);
329 if Gen.Have_Gaussian then
330 Result (Sys_Max_Image_Width + 2) := '1';
331 Insert_Image (Result, Sys_Max_Image_Width + 4,
332 Integer_64 (Long_Float'Fraction (Gen.Next_Gaussian)
334 Insert_Image (Result, Sys_Max_Image_Width + 24,
335 Integer_64 (Long_Float'Exponent (Gen.Next_Gaussian)));
338 Result (Sys_Max_Image_Width + 2) := '0';
344 end GNAT.Random_Numbers;