Skip to content
Permalink
master
Switch branches/tags
Go to file
 
 
Cannot retrieve contributors at this time
{---------------------------------------------------------------------------}
{ }
{ File: Velthuis.XorShifts.pas }
{ Function: Simple xorshift random number generators, implementing }
{ IRandom interface from Velthuis.RandomNumbers. }
{ Language: Delphi version XE3 or later }
{ Author: Rudy Velthuis }
{ Copyright: (c) 2018 Rudy Velthuis }
{ }
{ Literature: https://de.wikipedia.org/wiki/Xorshift }
{ https://en.wikipedia.org/wiki/Xorshift }
{ }
{ Acknowledgement: }
{ Several of the algorithms below were developed by }
{ Sebastiano Vigna and released to the public domain, }
{ see http://vigna.di.unimi.it/ }
{ }
{ License: Redistribution and use in source and binary forms, with or }
{ without modification, are permitted provided that the }
{ following conditions are met: }
{ }
{ * Redistributions of source code must retain the above }
{ copyright notice, this list of conditions and the following }
{ disclaimer. }
{ * Redistributions in binary form must reproduce the above }
{ copyright notice, this list of conditions and the following }
{ disclaimer in the documentation and/or other materials }
{ provided with the distribution. }
{ }
{ Disclaimer: THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER "AS IS" }
{ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT }
{ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND }
{ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO }
{ EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE }
{ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, }
{ OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
{ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, }
{ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED }
{ AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT }
{ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) }
{ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF }
{ ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. }
{ }
{---------------------------------------------------------------------------}
unit Velthuis.XorShifts;
interface
uses
Velthuis.RandomNumbers;
type
TXorShift32 = class(TRandomBase)
private
FSeed: UInt32;
protected
function GetSeed: Int64; override;
function Next(Bits: Integer): UInt32; override;
procedure SetSeed(Seed: Int64); override;
public
constructor Create;
end;
TXorShift64 = class(TRandomBase64)
private
FSeed: UInt64;
protected
function GetSeed: Int64; override;
function Next64(Bits: Integer): UInt64; override;
procedure SetSeed(Seed: Int64); override;
public
constructor Create;
end;
TXorShift128 = class(TRandomBase)
private
FSeed: array[0..3] of UInt32;
FSeedIndex: Integer;
protected
function GetSeed: Int64; override;
function Next(Bits: Integer): UInt32; override;
procedure SetSeed(Seed: Int64); override;
public
constructor Create;
end;
TXorWowState = array[0..4] of UInt32;
TXorWow = class(TRandomBase)
private
FSeed: TXorWowState;
FSeedIndex: Integer;
protected
function GetSeed: Int64; override;
function Next(Bits: Integer): UInt32; override;
procedure SetSeed(Seed: Int64); override;
public
constructor Create(const State: TXorWowState);
end;
TXorShift64Star = class(TRandomBase64)
private
FSeed: UInt64;
public
constructor Create(const State: UInt64);
function GetSeed: Int64; override;
function Next64(Bits: Integer): UInt64; override;
procedure SetSeed(Seed: Int64); override;
end;
TXorShift1024Star = class(TRandomBase64)
private
FSeed: array[0..15] of UInt64;
FSeedIndex: Integer;
FNextIndex: Integer;
protected
function GetSeed: Int64; override;
function Next64(Bits: Integer): UInt64; override;
procedure SetSeed(Seed: Int64); override;
public
constructor Create(State: array of UInt64);
end;
TXorShift128Plus = class(TRandomBase64)
private
FSeed: array[0..1] of UInt64;
FSeedIndex: Integer;
protected
function GetSeed: Int64; override;
function Next64(Bits: Integer): UInt64; override;
procedure SetSeed(Seed: Int64); override;
public
constructor Create(State0, State1: UInt64);
end;
implementation
uses
System.Math, Winapi.Windows;
{$RANGECHECKS OFF}
{$OVERFLOWCHECKS OFF}
function SplitMix64(var X: UInt64) : UInt64;
var
Z: UInt64;
begin
Inc(X, UInt64($9E3779B97F4A7C15));
Z := (X xor (X shr 30)) * UInt64($BF58476D1CE4E5B9);
Z := (Z xor (Z shr 27)) * UInt64($94D049BB133111EB);
Result := Z xor (Z shr 31);
end;
{ TXorShift32 }
constructor TXorShift32.Create;
var
C: Int64;
begin
if QueryPerformanceCounter(C) then
FSeed := UInt32(C)
else
FSeed := GetTickCount;
end;
function TXorShift32.GetSeed: Int64;
begin
Result := FSeed;
end;
function TXorShift32.Next(Bits: Integer): UInt32;
begin
FSeed := FSeed xor (FSeed shl 13);
FSeed := FSeed xor (FSeed shr 17);
FSeed := FSeed xor (FSeed shl 5);
Result := FSeed shr (32 - Bits);
end;
procedure TXorShift32.SetSeed(Seed: Int64);
begin
FSeed := UInt32(Seed);
end;
{ TXorShift64 }
constructor TXorShift64.Create;
var
C: Int64;
begin
if QueryPerformanceCounter(C) then
FSeed := C
else
FSeed := 88172645463325252 + GetTickCount;
end;
function TXorShift64.GetSeed: Int64;
begin
Result := Int64(FSeed);
end;
function TXorShift64.Next64(Bits: Integer): UInt64;
begin
FSeed := FSeed xor (FSeed shl 13);
FSeed := FSeed xor (FSeed shr 7);
FSeed := FSeed xor (FSeed shl 17);
Result := FSeed shr (64 - Bits);
end;
procedure TXorShift64.SetSeed(Seed: Int64);
begin
FSeed := UInt64(Seed);
end;
{ TXorShift128 }
constructor TXorShift128.Create;
begin
FSeed[0] := 123456789;
FSeed[1] := 362436069;
FSeed[2] := 521288629;
FSeed[3] := 88675123;
FSeedIndex := 0;
end;
function TXorShift128.GetSeed: Int64;
begin
Result := Int64(FSeed[1]) shl 32 + FSeed[0];
end;
function TXorShift128.Next(Bits: Integer): UInt32;
const
X = 0;
y = 1;
z = 2;
w = 3;
var
T: UInt32;
begin
T := FSeed[x] xor (FSeed[x] shl 11);
FSeed[x] := FSeed[y];
FSeed[y] := FSeed[z];
FSeed[z] := FSeed[w];
FSeed[w] := FSeed[w] xor ((FSeed[w] shr 19) xor T xor (T shr 8));
Result := FSeed[w] shr (32 - Bits);
end;
// Call twice to set full seed.
procedure TXorShift128.SetSeed(Seed: Int64);
begin
FSeed[FSeedIndex] := UInt32(Seed);
FSeed[FSeedIndex + 1] := UInt32(Seed shr 32);
FSeedIndex := (FSeedIndex + 2) and 3;
end;
{ TXorWow }
constructor TXorWow.Create(const State: TXorWowState);
begin
FSeed := State;
FSeedIndex := 0;
end;
function TXorWow.GetSeed: Int64;
begin
Result := Int64(FSeed[1]) shr 32 + FSeed[0];
end;
function TXorWow.Next(Bits: Integer): UInt32;
var
S, T: UInt32;
begin
T := FSeed[3];
T := T xor (T shr 2);
T := T xor (T shl 1);
FSeed[3] := FSeed[2];
FSeed[2] := FSeed[1];
FSeed[1] := FSeed[0];
S := FSeed[0];
T := T xor S;
T := T xor (S shl 4);
FSeed[0] := T;
FSeed[4] := FSeed[4] + 362437;
Result := (T + FSeed[4]) shr (32 - Bits);
end;
// Call thrice to set full seed.
procedure TXorWow.SetSeed(Seed: Int64);
begin
if FSeedIndex = 4 then
begin
FSeed[4] := UInt32(Seed);
FSeedIndex := 0;
end
else
begin
FSeed[FSeedIndex] := UInt32(Seed);
FSeed[FSeedIndex + 1] := UInt32(Seed shr 32);
FSeedIndex := FSeedIndex + 2;
end;
end;
{ TXorShift64Star }
constructor TXorShift64Star.Create(const State: UInt64);
begin
FSeed := State;
end;
function TXorShift64Star.GetSeed: Int64;
begin
Result := Int64(FSeed);
end;
function TXorShift64Star.Next64(Bits: Integer): UInt64;
var
X: UInt64;
begin
X := FSeed;
X := X xor (X shr 12);
X := X xor (X shl 25);
X := X xor (X shr 27);
FSeed := X;
Result := (X * UInt64($2545F4914F6CDD1D)) shr (64 - Bits);
end;
procedure TXorShift64Star.SetSeed(Seed: Int64);
begin
FSeed := UInt64(Seed);
end;
{ TXorShift1024Star }
constructor TXorShift1024Star.Create(State: array of UInt64);
var
I: Integer;
begin
for I := 0 to Max(High(State), High(FSeed)) do
FSeed[I] := State[I];
FSeedIndex := 0;
FNextIndex := 0;
end;
function TXorShift1024Star.GetSeed: Int64;
begin
Result := Int64(FSeed[FSeedIndex]);
end;
function TXorShift1024Star.Next64(Bits: Integer): UInt64;
var
S0, S1: UInt64;
begin
S0 := FSeed[FNextIndex];
FNextIndex := (FNextIndex + 1) and 15;
S1 := FSeed[FNextIndex];
S1 := S1 xor (S1 shl 31);
S1 := S1 xor (S1 shr 11);
S1 := S1 xor (S0 xor (S0 shr 30));
FSeed[FNextIndex] := S1;
Result := (S1 * UInt64(1181783497276652981)) shr (64 - Bits);
end;
procedure TXorShift1024Star.SetSeed(Seed: Int64);
begin
FSeed[FSeedIndex] := UInt64(Seed);
FSeedIndex := (FSeedIndex + 1) and 15;
end;
{ TXorShift182Plus }
constructor TXorShift128Plus.Create(State0, State1: UInt64);
begin
FSeed[0] := State0;
FSeed[1] := State1;
FSeedIndex := 0;
end;
function TXorShift128Plus.GetSeed: Int64;
begin
Result := FSeed[0];
end;
function TXorShift128Plus.Next64(Bits: Integer): UInt64;
var
X, Y: UInt64;
begin
X := FSeed[0];
Y := FSeed[1];
FSeed[0] := Y;
X := X xor (X shl 23);
FSeed[1] := X xor Y xor (X shr 17) xor (Y shr 26);
Result := (FSeed[1] + Y) shr (64 - Bits);
end;
procedure TXorShift128Plus.SetSeed(Seed: Int64);
begin
FSeed[FSeedIndex] := Seed;
FSeedIndex := FSeedIndex xor 1;
end;
end.