Finally a safe and math accurate random64bit function ! ;)

Hello,

Below is some code for a safe and math accurate 64 bit version of Lehmer's
pseudo random generator algorithm.

See comments for more details ;)

(Posting on usenet might mess up the layout, so you'll have to fix that a
little bit ;) )

*** Begin of Code ***

program TestRandom64bit;

{$APPTYPE CONSOLE}

{

A safe and math accurate 4x16 = 64 bit random version of Lehmer's pseudo
number random generator.

The code safe and mathematically accurate.

The only question remaining is if the distribution is good.

Probably not but at least all 0 to 2^64-2 values can be returned.

This code tests up to 2^63-2. (All positive return values for int64).

Testing all 64 bit possible return values would probably take way too long
with current hardware.

So this test is simply a manual test where you can look at it with your eye
ball ;)

Further some exceptional cases are tested to see if they happen to occur,
that would be good.

If they don't occur try initializing the RandSeed to something else or try
running more loops/tests.

It's kinda fun, you have more chance of winning the lottery than these
exceptional cases
of occuring ;)

The seed is initialized with the current time ;)

To increase the search speed try disabling the writeln statement because
that slows everything down ;)

The LehmerRandom32bitSafe function has been tested with a different program
and it's
considered to be totally safe for any 32 bit parameter.

Tested with range and overflow checking on. So far so good !

Finally a safe and accurate 64 bit version of random.

It's probably even better than Delphi's random function since that one seems
not to obbey the Lehmer algorithm... So Delphi's random function seems
flawed ?!?

The algorithms/code below still has to be tested some more for distribution
properties etc.

}

uses
  SysUtils;

var
 vLehmerRandSeedInt64 : int64 = 0;
 vLehmerMultiplierAInt64 : int64 = $08088405; // delphi's random parameter
 vLehmerAdditiveConstantCInt64 : int64 = $1; // delphi's random parameter

function LehmerRandom32bitSafe( ParaLehmerModulesMInt64 : int64 ) : int64;
begin
 if ParaLehmerModulesMInt64 > 0 then
 begin
  result := vLehmerRandSeedInt64;
  vLehmerRandSeedInt64 := vLehmerMultiplierAInt64 * vLehmerRandSeedInt64;
  vLehmerRandSeedInt64 := vLehmerRandSeedInt64 +
vLehmerAdditiveConstantCInt64;
  vLehmerRandSeedInt64 := vLehmerRandSeedInt64 mod ParaLehmerModulesMInt64;
 end else
 begin
  result := 0;
 end;
end;

// thanks to Mike Warren for this coding technique ;)
function Random64bit( ParaRange : int64 ) : int64;
var
 vBit00ToBit15 : Int64;
 vBit16toBit31 : Int64;
 vBit32toBit47 : Int64;
 vBit48toBit63 : Int64;
begin
 // ....||||....|||| ....||||....||||
 vBit48ToBit63 := (ParaRange and $FFFF000000000000) div $0001000000000000;
 vBit32ToBit47 := (ParaRange and $0000FFFF00000000) div $0000000100000000;
 vBit16ToBit31 := (ParaRange and $00000000FFFF0000) div $0000000000010000;
 vBit00ToBit15 := (ParaRange and $000000000000FFFF) {div $0000000000000001};

 // ....||||....||||
 Result :=
  LehmerRandom32bitSafe( vBit48ToBit63 ) * $0001000000000000 +
  LehmerRandom32bitSafe( vBit32ToBit47 ) * $0000000100000000 +
  LehmerRandom32bitSafe( vBit16ToBit31 ) * $0000000000010000 +
  LehmerRandom32bitSafe( vBit00ToBit15 ) {* $0000000000000001};

 // used to test bitmasks *** must be enabled to
(*
 Result :=
  vBit48ToBit63 * $0001000000000000 +
  vBit32ToBit47 * $0000000100000000 +
  vBit16ToBit31 * $0000000000010000 +
  vBit00ToBit15 {* $0000000000000001};
*)

end;

var
 vTest : int64;
 vTests : int64;
 vRange : int64;
 vResult : int64;
begin

 // seed initialized with TDateTime
 vLehmerRandSeedInt64 := int64(round(Now));

 vTests := 1024 * 1024 * 1024; // 1 gigabyte test ;)

 // for loop to limited.
 vTest := 0;
 while true do
 begin
  vTest := vTest + 1;

  // 1234567890123456789 = 19 digits max plus maybe one for negative
sign = 20 ;)
  // 2^63 = 9223372036854775808;
  // 2^63 = $8000000000000000;

  // test maximum positive range of int64;
  // ....||||....||||
  vRange := $8000000000000000;

  // used to test bit mask *** must be enabled too
(*
  vRange := $7FFFFFFFFFFFFFFE;
*)

  vResult := Random64bit( vRange );
  writeln( vResult:20 ); // disable this line for more speed.

  // be carefull when using windows calculator, when in hexadecimal mode
  // it expects all input via hexadecimal mode
  // inputting 2^32 would be wrong since that's decimal notation ;)

  // values to check with for bit 15, bit 31, bit 47
  // ....||||....||||
  // 2^15 = $0000000000008000 bit 15 only
  // 2^31 = $0000000080000000 bit 31 only
  // 2^47 = $0000800000000000 bit 47 only

  // check if exceptional cases are also encountered ;)
  if vResult = $0000000000008000 then
  begin
   writeln('Exceptional result $0000000000008000 encountered that''s good
!');
   writeln('press enter to continue test');
   readln;
  end else
  if vResult = $0000000080000000 then
  begin
   writeln('Exceptional result $0000000080000000 encountered that''s good
!');
   writeln('press enter to continue test');
   readln;
  end else
  if vResult = $0000800000000000 then
  begin
   writeln('Exceptional result $0000800000000000 encountered that''s good
!');
   writeln('press enter to continue test');
   readln;
  end;

  // values to check with for positive bits in return values
  // ....||||....||||
  // 2^16 - 1 = $000000000000FFFF; // bit 0 to bit 15 set
  // 2^32 - 1 = $00000000FFFFFFFF; // bit 0 to bit 31 set
  // 2^48 - 1 = $0000FFFFFFFFFFFF; // bit 0 to bit 47 set
  // 2^63 - 2 = $7FFFFFFFFFFFFFFE; // bit 1 to bit 62 set

  // check if exceptional cases are also encountered ;)
  if vResult = $000000000000FFFF then
  begin
   writeln('Exceptional result $000000000000FFFF encountered that''s good
!');
   writeln('press enter to continue test');
   readln;
  end else
  if vResult = $00000000FFFFFFFF then
  begin
   writeln('Exceptional result $00000000FFFFFFFF encountered that''s good
!');
   writeln('press enter to continue test');
   readln;
  end else
  if vResult = $0000FFFFFFFFFFFF then
  begin
   writeln('Exceptional result $0000FFFFFFFFFFFF encountered that''s good
!');
   writeln('press enter to continue test');
   readln;
  end else
  if vResult = $7FFFFFFFFFFFFFFE then
  begin
   writeln('Exceptional result $7FFFFFFFFFFFFFFE encountered that''s good
!');
   writeln('press enter to continue test');
   readln;
  end;

  if vTest >= vTests then break;
 end;

 writeln('press enter to continue');
 readln;
end.

// *** End of Code ***

Bye,
  Skybuck.
Received on Mon May 1 02:05:56 2006