with Ada.Calendar;
package body Ada.Numerics.Float_Random is
type Pointer is access all State;
procedure Euclid (P, Q : in Int; X, Y : out Int; GCD : out Int);
function Euclid (P, Q : Int) return Int;
function Square_Mod_N (X, N : Int) return Int;
procedure Euclid (P, Q : in Int; X, Y : out Int; GCD : out Int) is
XT : Int := 1;
YT : Int := 0;
procedure Recur
(P, Q : in Int; X, Y : in Int; XP, YP : in out Int; GCD : out Int);
procedure Recur
(P, Q : in Int;
X, Y : in Int;
XP, YP : in out Int;
GCD : out Int)
is
Quo : Int := P / Q; XT : Int := X; YT : Int := Y;
begin
if P rem Q = 0 then GCD := Q;
XP := X;
YP := Y;
else
Recur (Q, P - Q * Quo, XP - Quo * X, YP - Quo * Y, XT, YT, Quo);
XP := XT;
YP := YT;
GCD := Quo;
end if;
end Recur;
begin
Recur (P, Q, 0, 1, XT, YT, GCD);
X := XT;
Y := YT;
end Euclid;
function Euclid (P, Q : Int) return Int is
X, Y, GCD : Int;
begin
Euclid (P, Q, X, Y, GCD);
return X;
end Euclid;
function Image (Of_State : State) return String is
begin
return Int'Image (Of_State.X1) & ',' & Int'Image (Of_State.X2)
& ',' &
Int'Image (Of_State.P) & ',' & Int'Image (Of_State.Q);
end Image;
function Random (Gen : Generator) return Uniformly_Distributed is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
begin
Genp.X1 := Square_Mod_N (Genp.X1, Genp.P);
Genp.X2 := Square_Mod_N (Genp.X2, Genp.Q);
return
Float ((Flt (((Genp.X2 - Genp.X1) * Genp.X)
mod Genp.Q) * Flt (Genp.P)
+ Flt (Genp.X1)) * Genp.Scl);
end Random;
procedure Reset (Gen : in Generator; Initiator : in Integer) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
X1, X2 : Int;
begin
X1 := 2 + Int (Initiator) mod (K1 - 3);
X2 := 2 + Int (Initiator) mod (K2 - 3);
for J in 1 .. 5 loop
X1 := Square_Mod_N (X1, K1);
X2 := Square_Mod_N (X2, K2);
end loop;
Genp.all :=
(X1 => X1,
X2 => X2,
P => K1,
Q => K2,
X => 1,
Scl => Scal);
end Reset;
procedure Reset (Gen : Generator; From_State : State) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
begin
Genp.all := From_State;
end Reset;
procedure Reset (Gen : Generator) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
Now : constant Calendar.Time := Calendar.Clock;
X1, X2 : Int;
begin
X1 := Int (Calendar.Year (Now)) * 12 * 31 +
Int (Calendar.Month (Now)) * 31 +
Int (Calendar.Day (Now));
X2 := Int (Calendar.Seconds (Now) * Duration (1000.0));
X1 := 2 + X1 mod (K1 - 3);
X2 := 2 + X2 mod (K2 - 3);
for J in 1 .. 5 loop
X1 := Square_Mod_N (X1, K1);
X2 := Square_Mod_N (X2, K2);
end loop;
Genp.all :=
(X1 => X1,
X2 => X2,
P => K1,
Q => K2,
X => 1,
Scl => Scal);
end Reset;
procedure Save (Gen : in Generator; To_State : out State) is
begin
To_State := Gen.Gen_State;
end Save;
function Square_Mod_N (X, N : Int) return Int is
Temp : Flt := Flt (X) * Flt (X);
Div : Int := Int (Temp / Flt (N));
begin
Div := Int (Temp - Flt (Div) * Flt (N));
if Div < 0 then
return Div + N;
else
return Div;
end if;
end Square_Mod_N;
function Value (Coded_State : String) return State is
Start : Positive := Coded_State'First;
Stop : Positive := Coded_State'First;
Outs : State;
begin
while Coded_State (Stop) /= ',' loop
Stop := Stop + 1;
end loop;
Outs.X1 := Int'Value (Coded_State (Start .. Stop - 1));
Start := Stop + 1;
loop
Stop := Stop + 1;
exit when Coded_State (Stop) = ',';
end loop;
Outs.X2 := Int'Value (Coded_State (Start .. Stop - 1));
Start := Stop + 1;
loop
Stop := Stop + 1;
exit when Coded_State (Stop) = ',';
end loop;
Outs.P := Int'Value (Coded_State (Start .. Stop - 1));
Outs.Q := Int'Value (Coded_State (Stop + 1 .. Coded_State'Last));
Outs.X := Euclid (Outs.P, Outs.Q);
Outs.Scl := 1.0 / (Flt (Outs.P) * Flt (Outs.Q));
if Outs.Q < 31 or else Outs.P < 31
or else Outs.X1 not in 2 .. Outs.P - 1
or else Outs.X2 not in 2 .. Outs.Q - 1
then
raise Constraint_Error;
end if;
return Outs;
end Value;
end Ada.Numerics.Float_Random;