{******************************************************************************}
{                                                                              }
{   Library:          Fundamentals 5.00                                        }
{   File name:        flcRandom.pas                                            }
{   File version:     5.20                                                     }
{   Description:      Random number functions                                  }
{                                                                              }
{   Copyright:        Copyright (c) 1999-2020, David J Butler                  }
{                     All rights reserved.                                     }
{                     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.                                    }
{                     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND   }
{                     CONTRIBUTORS "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 REGENTS 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.                              }
{                                                                              }
{   Github:           https://github.com/fundamentalslib                       }
{   E-mail:           fundamentals.library at gmail.com                        }
{                                                                              }
{ Revision history:                                                            }
{                                                                              }
{   1999/11/07  0.01  Add RandomSeed.                                          }
{   1999/12/01  0.02  Add RandomUniform.                                       }
{   1999/12/03  0.03  Add RandomNormal.                                        }
{   2000/01/23  1.04  Add RandomPseudoWord.                                    }
{   2000/07/13  1.05  Fix bug reported by Andrew Driazgov.                     }
{   2000/08/22  1.06  Add RandomHex.                                           }
{   2000/09/20  1.07  Improve RandomSeed.                                      }
{   2002/06/01  3.08  Create cRandom unit.                                     }
{   2003/08/09  3.09  Replace random number generator.                         }
{   2005/06/10  4.10  Compilable with FreePascal 2 Win32 i386.                 }
{   2005/08/27  4.11  Revised for Fundamentals 4.                              }
{   2007/06/08  4.12  Compilable with FreePascal 2.04 Win32 i386               }
{   2010/06/27  4.13  Compilable with FreePascal 2.4.0 OSX x86-64              }
{   2015/04/19  4.14  Changes for 64-bit compilers and RawByteString           }
{   2015/04/20  4.15  Revise RandomSeed                                        }
{   2015/05/06  4.16  Prevent mwcRandom32 overflow error.                      }
{   2016/01/09  5.17  Revised for Fundamentals 5.                              }
{   2018/08/12  5.18  String type changes.                                     }
{   2019/03/22  5.19  FreePascal 3.04 Win64 changes.                           }
{   2019/06/06  5.20  Add RandomBytes.                                         }
{                                                                              }
{ Supported compilers:                                                         }
{                                                                              }
{   Delphi 2010-10.4 Win32/Win64        5.20  2020/06/02                       }
{   Delphi 10.2-10.4 Linux64            5.20  2020/06/02                       }
{   FreePascal 3.0.4 Win64              5.20  2020/06/02                       }
{                                                                              }
{******************************************************************************}

// See http://www.romu-random.org/code.c

{$INCLUDE ..\flcInclude.inc}

{$IFDEF FREEPASCAL}{$IFDEF DEBUG}
  {$WARNINGS OFF}{$HINTS OFF}
{$ENDIF}{$ENDIF}

unit flcRandom;

interface

uses
  { System }
  SysUtils,

  { Fundamentals }
  flcStdTypes;



{                                                                              }
{ RandomSeed                                                                   }
{                                                                              }
{   RandomSeed returns a random seed value based on various system states.     }
{   AddEntropy can be called to add additional random state to the values      }
{     returned by RandomSeed.                                                  }
{                                                                              }
procedure AddEntropy(const Value: Int64);
function  RandomSeed32: Word32;



{                                                                              }
{ Uniform random number generator                                              }
{                                                                              }
{   Returns a random number from a uniform density distribution (ie all        }
{     values have an equal probability of being 'chosen')                      }
{   RandomFloat returns an uniformly distributed random floating point value   }
{     between 0 and 1.                                                         }
{   RandomAlphaStr returns a string of random letters (A-Z).                   }
{   RandomPseudoWord returns a random word-like string.                        }
{                                                                              }
procedure SetRandomSeed(const Seed: Word32);

function  RandomUniform32: Word32;
function  RandomUniform64: Word64;
function  RandomUniform(const N: Integer): Integer;
function  RandomUniform16: Word;
function  RandomByte: Byte;
function  RandomByteNonZero: Byte;
function  RandomBoolean: Boolean;
function  RandomInt64: Int64; overload;
function  RandomInt64(const N: Int64): Int64; overload;

function  RandomBytes(const N: Integer): TBytes;

function  RandomHex(const Digits: Integer; const UpperCase: Boolean = True): String;
function  RandomHexB(const Digits: Integer; const UpperCase: Boolean = True): UTF8String;
function  RandomHexU(const Digits: Integer; const UpperCase: Boolean = True): UnicodeString;

function  RandomFloat: Extended;

function  RandomUpperAlphaStrB(const Length: Integer): UTF8String;
function  RandomPseudoWordB(const Length: Integer): UTF8String;
function  RandomPasswordB(const MinLength, MaxLength: Integer;
          const CaseSensitive, UseSymbols, UseNumbers: Boolean): UTF8String;



{                                                                              }
{ Alternative uniform random number generators                                 }
{                                                                              }
function  mwcRandom32: Word32;
function  urnRandom32: Word32;
function  moaRandomFloat: Extended;
function  mwcRandomFloat: Extended;



{                                                                              }
{ Normal distribution random number generator                                  }
{                                                                              }
{   RandomNormalF returns a random number that has a Normal(0,1) distribution  }
{     (Gaussian distribution)                                                  }
{                                                                              }
function  RandomNormalF: Extended;



{                                                                              }
{ Test cases                                                                   }
{                                                                              }
{$IFDEF DEBUG}
{$IFDEF TEST}
procedure Test;
{$ENDIF}
{$ENDIF}



implementation

uses
  { System }
  {$IFDEF MSWIN}
  Windows
  {$ENDIF}

  {$IFDEF UNIX}
  {$IFDEF FREEPASCAL}
  BaseUnix,
  Unix
  {$ENDIF}
  {$ENDIF}

  {$IFDEF POSIX}
  {$IFDEF DELPHI}
  Posix.SysTime
  {$ENDIF}
  {$ENDIF}
  ;



{                                                                              }
{ Linear Congruential Random Number Generators                                 }
{   The general form of a linear congruential generator is:                    }
{   SEED = (A * SEED + C) mod M                                                }
{                                                                              }
function lcRandom1(const Seed: Word32): Word32;
begin
  Result := Word32(29943829 * Int64(Seed) - 1);
end;

function lcRandom2(const Seed: Word32): Word32;
begin
  Result := Word32(69069 * Int64(Seed) + 1);
end;

function lcRandom3(const Seed: Word32): Word32;
begin
  Result := Word32(1103515245 * Int64(Seed) + 12345);
end;

function lcRandom4(const Seed: Word32): Word32;
begin
  Result := Word32(214013 * Int64(Seed) + 2531011);
end;

function lcRandom5(const Seed: Word32): Word32;
begin
  Result := Word32(134775813 * Int64(Seed) + 1);
end;



{                                                                              }
{ System sources of pseudo-randomness                                          }
{                                                                              }
{$IFDEF WindowsPlatform}
function GetHighPrecisionCounter: Int64;
begin
  QueryPerformanceCounter(Result);
end;
{$ENDIF}

{$IFDEF UNIX}
{$IFDEF FREEPASCAL}
function GetHighPrecisionCounter: Int64;
var TV : TTimeVal;
    TZ : PTimeZone;
begin
  TZ := nil;
  fpGetTimeOfDay(@TV, TZ);
  Result := Int64(TV.tv_sec) * 1000000 + Int64(TV.tv_usec);
end;
{$ENDIF}
{$ENDIF}

{$IFDEF POSIX}
{$IFDEF DELPHI}
function GetHighPrecisionCounter: Int64;
var T : timeval;
begin
  GetTimeOfDay(T, nil);
  Result := Int64(T.tv_sec) * 1000000 + Int64(T.tv_usec);
end;
{$ENDIF}
{$ENDIF}

{$IFDEF WindowsPlatform}
function GetTick: Word32;
begin
  Result := GetTickCount;
end;
{$ELSE}{$IFDEF UNIX}
function GetTick: Word32;
begin
  Result := Word32(DateTimeToTimeStamp(Now).Time);
end;
{$ELSE}
{$IFDEF POSIX}
function GetTick: Word32;
begin
  Result := Word32(DateTimeToTimeStamp(Now).Time);
end;
{$ENDIF}
{$ENDIF}{$ENDIF}

function RandomState: Int64;
var
  H, Mi, S, S1 : Word;
  Ye, Mo, Da   : Word;
begin
  Result := 0;
  { Counters }
  {$IFNDEF ANDROID}
  Result := Result xor GetHighPrecisionCounter;
  Result := Result xor (Int64(GetTick) shl 32);
  {$ENDIF}
  { System Time }
  DecodeTime(Time, H, Mi, S, S1);
  Result := Result xor Int64(H) xor (Int64(Mi) shl 8) xor (Int64(S1) shl 16) xor (Int64(S) shl 24);
  { System Date }
  DecodeDate(Date, Ye, Mo, Da);
  Result := Result xor (Int64(Ye) shl 32) xor (Int64(Mo) shl 48) xor (Int64(Da) shl 56);
end;

function HashBuffer(const Buffer: PByte; const Len: Integer): Word32;
var
  I : Integer;
  P : PByte;
begin
  Result := 0;
  P := Buffer;
  for I := 1 to Len do
    begin
      Result := Result xor (P^ shl ((I mod 7) * 4));
      Inc(P);
    end;
end;

function StrHashB(const S: RawByteString): Word32;
var
  L : Integer;
begin
  Result := 0;
  L := Length(S);
  if L <= 0 then
    exit;
  Result := HashBuffer(@S[1], Length(S));
end;

{$IFDEF MSWIN}
function GetCPUFrequency: Int64;
var
  F : Int64;
begin
  F := 0;
  if not QueryPerformanceFrequency(F) then
    F := 0;
  Result := F;
end;
{$ENDIF}

{$IFDEF MSWIN}
function StrLenA(const A: PAnsiChar): Integer;
var L : Integer;
begin
  if not Assigned(A) then
    begin
      Result := 0;
      exit;
    end;
  L := 0;
  while A[L] <> #0 do
    Inc(L);
  Result := L;
end;

function StrZPasB(const A: PAnsiChar): UTF8String;
var
  I, L : Integer;
begin
  L := StrLenA(A);
  SetLength(Result, L);
  if L = 0 then
    exit;
  I := 0;
  while I < L do
    begin
      Result[I + 1] := A[I];
      Inc(I);
    end;
end;

function GetOSUserName: UTF8String;
var
  L : Word32;
  B : array[0..258] of Byte;
begin
  L := 256;
  FillChar(B[0], Sizeof(B), 0);
  if GetUserNameA(@B, L) then
    Result := StrZPasB(@B)
  else
    Result := '';
end;

function GetOSComputerName: UTF8String;
var
  L : Word32;
  B : array[0..258] of Byte;
begin
  L := 256;
  FillChar(B[0], Sizeof(B), 0);
  if GetComputerNameA(@B, L) then
    Result := StrZPasB(@B)
  else
    Result := '';
end;
{$ENDIF}

{$IFDEF UNIX}
function GetOSUserName: UTF8String;
var
  T : RawByteString;
begin
  T := GetEnvironmentVariable('USER');
  if T = '' then
    T := GetEnvironmentVariable('USERNAME');
  Result := T;
end;

function GetOSComputerName: UTF8String;
begin
  Result := GetEnvironmentVariable('HOSTNAME');
end;
{$ENDIF}

{$IFDEF MSWIN}
function WinRandomState: Int64;
var
  F : Word32;
  H : THandle;
  T1, T2, T3, T4 : TFileTime;
  A, B : Word32;
  S : Int64;
begin
  S := 0;
  { Thread times }
  F := GetCurrentThreadID;
  S := S xor F;
  H := GetCurrentThread;
  S := S xor Int64(H);
  GetThreadTimes(H, T1, T2, T3, T4);
  A := T1.dwLowDateTime  xor T2.dwLowDateTime  xor T3.dwLowDateTime  xor T4.dwLowDateTime;
  B := T1.dwHighDateTime xor T2.dwHighDateTime xor T3.dwHighDateTime xor T4.dwHighDateTime;
  S := S xor A;
  S := S xor (Int64(B) shl 32);
  { Process times }
  F := GetCurrentProcessId;
  S := S xor F;
  H := GetCurrentProcess;
  S := S xor Int64(H);
  GetProcessTimes(H, T1, T2, T3, T4);
  A := T1.dwLowDateTime  xor T2.dwLowDateTime  xor T3.dwLowDateTime  xor T4.dwLowDateTime;
  B := T1.dwHighDateTime xor T2.dwHighDateTime xor T3.dwHighDateTime xor T4.dwHighDateTime;
  S := S xor A;
  S := S xor (Int64(B) shl 32);
  { System times }
  {$IFDEF DELPHI2010_UP}
  GetSystemTimes(T1, T2, T3);
  A := T1.dwLowDateTime  xor T2.dwLowDateTime  xor T3.dwLowDateTime;
  B := T1.dwHighDateTime xor T2.dwHighDateTime xor T3.dwHighDateTime;
  S := S xor A;
  S := S xor (Int64(B) shl 32);
  {$ENDIF}
  Result := S;
end;
{$ENDIF}



{                                                                              }
{ RandomSeed                                                                   }
{   The random seed is generated from a startup seed, a fixed seed, a          }
{   variable seed and an entropy seed.                                         }
{   The startup seed is initialised on module initialisation.                  }
{   The fixed seed is randomised on the first call to RandomSeed.              }
{   The variable seed is randomised on every call to RandomSeed.               }
{                                                                              }
var
  EntropySeed   : Int64 = 0;
  StartupSeed   : Int64 = 0;
  FixedSeedInit : Boolean = False;
  FixedSeed     : Int64 = 0;
  VariableSeed  : Int64 = 0;

function SeedMix1(const A, B: Word32): Int64;
begin
  Result :=
       Int64(lcRandom3(A)) or
      (Int64(lcRandom4(B)) shl 32);
end;

function SeedMix2(const A, B: Word32): Int64;
begin
  Result :=
       Int64(lcRandom1(A)) or
      (Int64(lcRandom2(B)) shl 32);
end;

function SeedMix3(const A, B: Word32): Int64;
begin
  Result :=
       Int64(lcRandom2(A)) or
      (Int64(lcRandom5(B)) shl 32);
end;

function SeedMix4(const A, B: Word32): Int64;
begin
  Result :=
       Int64(lcRandom4(A)) or
      (Int64(lcRandom2(B)) shl 32);
end;

function SeedMix5(const A, B: Word32): Int64;
begin
  Result :=
       Int64(lcRandom5(A)) or
      (Int64(lcRandom1(B)) shl 32);
end;

function SeedMix1_64(const S: Int64): Int64;
begin
  Result := SeedMix1(Word32(S), Word32(S shr 32));
end;

function SeedMix2_64(const S: Int64): Int64;
begin
  Result := SeedMix2(Word32(S), Word32(S shr 32));
end;

function SeedMix3_64(const S: Int64): Int64;
begin
  Result := SeedMix3(Word32(S), Word32(S shr 32));
end;

function SeedMix4_64(const S: Int64): Int64;
begin
  Result := SeedMix4(Word32(S), Word32(S shr 32));
end;

function SeedMix5_64(const S: Int64): Int64;
begin
  Result := SeedMix5(Word32(S), Word32(S shr 32));
end;

procedure AddEntropy(const Value: Int64);
var
  S : Int64;
begin
  S := EntropySeed xor Value;
  S := SeedMix1_64(S);
  EntropySeed := S;
end;

// The StartupSeed is initialised on module initialisation
procedure InitStartupSeed;
var
  S : Int64;
begin
  { Initialise startup seed }
  S := RandomState;
  S := SeedMix2_64(S);
  StartupSeed := S;
  { Initialise entropy seed }
  AddEntropy(RandomState);
end;

// The FixedSeed is initialised on the first call to RandomSeed
{$IFDEF DELPHI5}{$OPTIMIZATION OFF}{$ENDIF}
{$IFOPT Q+}{$DEFINE QOn}{$Q-}{$ELSE}{$UNDEF QOn}{$ENDIF}
procedure InitFixedSeed;
var
  S : Int64;
  Q : Pointer;
begin
  { Startup Seed }
  S := StartupSeed;
  { System State }
  S := S xor RandomState;
  {$IFDEF MSWIN}
  S := S xor WinRandomState;
  {$ENDIF}
  { Pointer Values }
  Q := @FixedSeed; // Global variable
  S := Int64(S + Int64(NativeUInt(Q)));
  Q := @S; // Local variable
  S := Int64(S + Int64(NativeUInt(Q)));
  GetMem(Q, 17); // Heap memory
  S := Int64(S + Int64(NativeUInt(Q)));
  FreeMem(Q);
  {$IFDEF MSWIN}
  { CPU Frequency }
  S := S xor GetCPUFrequency;
  { OS User Name }
  S := Int64(S + StrHashB(GetOSUserName));
  { OS Computer Name }
  S := Int64(S + StrHashB(GetOSComputerName));
  {$ENDIF}
  {$IFDEF UNIX}
  { OS User Name }
  S := Int64(S + Int64(StrHashB(GetOSUserName)));
  { OS Computer Name }
  S := Int64(S + Int64(StrHashB(GetOSComputerName)));
  { PPID }
  S := Int64(S + Int64(StrHashB(GetEnvironmentVariable('PPID'))));
  {$ENDIF}
  { System Timing }
  S := Int64(S + RandomState);
  Sleep(0);
  S := Int64(S + RandomState);
  Sleep(1);
  S := Int64(S + RandomState);
  {$IFDEF MSWIN}
  S := Int64(S + WinRandomState);
  {$ENDIF}
  Sleep(0);
  S := Int64(S + RandomState);
  { Mix bits }
  S := SeedMix3_64(S);
  { Save fixed seed }
  FixedSeed := S;
  FixedSeedInit := True;
end;
{$IFDEF QOn}{$Q+}{$ENDIF}
{$IFDEF DELPHI5}{$OPTIMIZATION ON}{$ENDIF}

{$IFDEF DELPHI5}{$OPTIMIZATION OFF}{$ENDIF}
{$IFOPT Q+}{$DEFINE QOn}{$Q-}{$ELSE}{$UNDEF QOn}{$ENDIF}
function RandomSeed32: Word32;
var
  S : Int64;
begin
  { Fixed Seed }
  if not FixedSeedInit then
    InitFixedSeed;
  S := FixedSeed;
  { Entropy Seed }
  S := Int64(S + EntropySeed);
  { Variable Seed }
  S := Int64(S + VariableSeed);
  { System State }
  S := Int64(S + RandomState);
  {$IFDEF MSWIN}
  S := Int64(S + WinRandomState);
  {$ENDIF}
  { Mix bits }
  S := SeedMix5_64(S);
  { Update variable seed }
  VariableSeed := VariableSeed xor S;
  VariableSeed := SeedMix4_64(VariableSeed);
  { Mix/Reduce seed into result }
  Result := Word32(S) xor
            Word32(S shr 32);
end;
{$IFDEF QOn}{$Q+}{$ENDIF}
{$IFDEF DELPHI5}{$OPTIMIZATION ON}{$ENDIF}

procedure RandomSeedFinalise;
begin
  EntropySeed  := 0;
  StartupSeed  := 0;
  FixedSeed    := 0;
  VariableSeed := 0;
end;



{                                                                              }
{ Mother-of-All pseudo random number generator                                 }
{   This is a multiply-with-carry or recursion-with-carry generator.           }
{   It has a cycle length of 3E+47.                                            }
{   It was invented by George Marsaglia.                                       }
{                                                                              }
var
  moaSeeded : Boolean = False;
  moaX      : array[0..3] of Word32;
  moaC      : Word32;

procedure moaInitSeed(const Seed: Word32);
var
  I : Integer;
  S : Word32;
begin
  S := Seed;
  for I := 0 to 3 do
    begin
      S := lcRandom1(S);
      moaX[I] := S;
    end;
  moaC := lcRandom1(S);
  moaSeeded := True;
end;

function moaRandom32: Word32;
var
  S  : Int64;
  Xn : Word32;
begin
  if not moaSeeded then
    moaInitSeed(RandomSeed32);
  S := 2111111111 * Int64(moaX[0]) +
             1492 * Int64(moaX[1]) +
             1776 * Int64(moaX[2]) +
             5115 * Int64(moaX[3]) +
                    Int64(moaC);
  moaC := Word32(S shr 32);
  Xn := Word32(S);
  moaX[0] := moaX[1];
  moaX[1] := moaX[2];
  moaX[2] := moaX[3];
  moaX[3] := Xn;
  Result := Xn;
end;

function moaRandomFloat: Extended;
begin
  Result := moaRandom32 / High(Word32);
end;

procedure moaFinalise;
begin
  if moaSeeded then
    begin
      moaX[0] := 0;
      moaX[1] := 0;
      moaX[2] := 0;
      moaX[3] := 0;
      moaC := 0;
    end;
end;



{                                                                              }
{ Multiply-With-Carry pseudo random number generator mentioned by George       }
{ Marsaglia in his paper on the Mother-of-All generator:                       }
{   " Here is an interesting simple MWC generator with period > 2^92, for      }
{   32-bit arithmetic:                                                         }
{   x[n]=1111111464*(x[n-1]+x[n-2]) + carry mod 2^32.                          }
{   Suppose you have functions, say top() and bot(), that give the top and     }
{   bottom halves of a 64-bit result.  Then, with initial 32-bit x, y and      }
{   carry c,  simple statements such as                                        }
{          y=bot(1111111464*(x+y)+c)                                           }
{          x=y                                                                 }
{          c=top(y)                                                            }
{   will, repeated, give over 2^92 random 32-bit y's. "                        }
{                                                                              }
var
  mwcSeeded : Boolean = False;
  mwcX      : Word32;
  mwcY      : Word32;
  mwcC      : Word32;

procedure mwcInitSeed(const Seed: Word32);
begin
  mwcX := lcRandom2(Seed);
  mwcY := lcRandom2(mwcX);
  mwcC := lcRandom2(mwcY);
  mwcSeeded := True;
end;

function mwcRandom32: Word32;
var S, T : UInt64;
begin
  if not mwcSeeded then
    mwcInitSeed(RandomSeed32);
  S := 1111111464;
  {$IFOPT Q+}{$DEFINE QOn}{$Q-}{$ELSE}{$UNDEF QOn}{$ENDIF}
  T := mwcX;
  T := T + mwcY;
  S := S * T;
  S := S + mwcC;
  {$IFDEF QOn}{$Q+}{$ENDIF}
  Result := Word32(S);
  mwcX := mwcY;
  mwcY := Result;
  mwcC := Word32(S shr 32);
end;

function mwcRandomFloat: Extended;
begin
  Result := mwcRandom32 / High(Word32);
end;

procedure mwcFinalise;
begin
  if mwcSeeded then
    begin
      mwcX := 0;
      mwcY := 0;
      mwcC := 0;
    end;
end;



{                                                                              }
{ Universal random number generator proposed by Marsaglia, Zaman, and Tsang.   }
{ FSU-SCRI-87-50                                                               }
{   It has a period of 2^144 = 2E+43.                                          }
{   Only 24 bits are guarantueed to be completely random.                      }
{   This generator passes all known statistical tests on randomness.           }
{   The algorithm is a combination of a Fibonacci sequence and an arithmetic   }
{   sequence.                                                                  }
{                                                                              }
var
  urnSeeded : Boolean = False;
  urnU      : array[1..97] of Double;
  urnC      : Double;
  urnCD     : Double;
  urnCM     : Double;
  urnI      : Integer;
  urnJ      : Integer;

procedure urnInit(const IJ, KL: Integer);
var I, J, K, L : Integer;
    F, G, M    : Integer;
    S, T       : Double;
begin
  Assert((IJ >= 0) and (IJ <= 31328) and (KL >= 0) and (KL <= 30081));
  I := (IJ div 177) mod 177 + 2;
  J := IJ mod 177 + 2;
  K := (KL div 169) mod 178 + 1;
  L := KL mod 169;
  for F := 1 to 97 do
    begin
      S := 0.0;
      T := 0.5;
      for G := 1 to 24 do
        begin
          M := (((I * J) mod 179) * K) mod 179;
          I := J;
          J := K;
          K := M;
          L := (53 * L + 1) mod 169;
          if ((L * M) mod 64 >= 32) then
            S := S + T;
          T := T * 0.5;
        end;
      urnU[F] := S;
    end;
  urnC  := 362436.0 / 16777216.0;
  urnCD := 7654321.0 / 16777216.0;
  urnCM := 16777213.0 / 16777216.0;
  urnI  := 97;
  urnJ  := 33;
  urnSeeded := True;
end;

procedure urnInitSeed(const Seed: Word32);
begin
  urnInit((Seed and $FFFF) mod 30000, (Seed shr 16) mod 30000);
end;

function urnRandomFloat: Double;
var R : Double;
begin
  if not urnSeeded then
    urnInitSeed(RandomSeed32);
  R := urnU[urnI] - urnU[urnJ];
  if R < 0.0 then
    R := R + 1.0;
  urnU[urnI] := R;
  Dec(urnI);
  if urnI = 0 then
    urnI := 97;
  Dec(urnJ);
  if urnJ = 0 then
    urnJ := 97;
  urnC := urnC - urnCD;
  if urnC < 0.0 then
    urnC := urnC + urnCM;
  R := R - urnC;
  if R < 0.0 then
    R := R + 1.0;
  Result := R;
end;

function urnRandom32: Word32;
begin
  Result := Word32(Trunc(urnRandomFloat * 4294967295.0));
end;

procedure urnFinalise;
var
  I : Integer;
begin
  if urnSeeded then
    begin
      for I := 1 to 97 do
        urnU[I] := 0.0;
      urnC := 0.0;
      urnCD := 0.0;
      urnCM := 0.0;
      urnI := 0;
      urnJ := 0;
    end;
end;



{                                                                              }
{ Uniform Random                                                               }
{                                                                              }
procedure SetRandomSeed(const Seed: Word32);
begin
  moaInitSeed(Seed);
end;

function RandomUniform32: Word32;
begin
  Result := moaRandom32;
end;

function RandomUniform64: Word64;
begin
  Result :=
      Word64(moaRandom32) or
      Word64(Word64(moaRandom32) shl 32);
end;

function RandomUniform(const N: Integer): Integer;
begin
  if N <= 1 then
    Result := 0
  else
    Result := Integer(RandomUniform32 mod Word32(N));
end;

function RandomUniform16: Word;
var I : Word32;
begin
  I := RandomUniform32;
  I := I xor (I shr 16);
  Result := Word(I and $FFFF);
end;

function RandomByte: Byte;
var I : Word32;
begin
  I := RandomUniform32;
  I := I xor (I shr 8) xor (I shr 16) xor (I shr 24);
  Result := Byte(I and $FF);
end;

function RandomByteNonZero: Byte;
begin
  repeat
    Result := RandomByte;
  until Result <> 0;
end;

function RandomBoolean: Boolean;
begin
  Result := RandomUniform32 and 1 = 1;
end;

function RandomFloat: Extended;
begin
  Result := urnRandomFloat;
end;

function RandomInt64: Int64;
begin
  Result :=
     Int64(RandomUniform32) or
     Int64(Int64(RandomUniform32) shl 32);
end;

function RandomInt64(const N: Int64): Int64;
begin
  if N <= 0 then
    Result := 0
  else
    begin
      Result := RandomInt64;
      if Result < 0 then
        Result := -Result;
      Result := Result mod N;
    end;
end;

function RandomBytes(const N: Integer): TBytes;
var
  B : TBytes;
  P, Q : PByte;
  I, L : Integer;
  R : Word32;
begin
  if N <= 0 then
    begin
      Result := nil;
      exit;
    end;
  SetLength(B, N);
  P := Pointer(B);
  L := N div 4;
  for I := 0 to L - 1 do
    begin
      PWord32(P)^ := RandomUniform32;
      Inc(P, SizeOf(Word32));
    end;
  L := N mod 4;
  if L > 0 then
    begin
      R := RandomUniform32;
      Q := @R;
      for I := 0 to L - 1 do
        begin
          P^ := Q^;
          Inc(P);
          Inc(Q);
        end;
    end;
  Result := B;
end;

const
  HexDigitsHi  : String        = '0123456789ABCDEF';
  HexDigitsHiA : UTF8String    = '0123456789ABCDEF';
  HexDigitsHiU : UnicodeString = '0123456789ABCDEF';
  HexDigitsLo  : String        = '0123456789abcdef';
  HexDigitsLoA : UTF8String    = '0123456789abcdef';
  HexDigitsLoU : UnicodeString = '0123456789abcdef';

function RandomHex(const Digits: Integer; const UpperCase: Boolean): String;
var
  I : Integer;
  D : Integer;
  C : Char;
begin
  if Digits <= 0 then
    begin
      Result := '';
      exit;
    end;
  SetLength(Result, Digits);
  for I := 1 to Digits do
    begin
      D := 1 + RandomUniform(16);
      if UpperCase then
        C := HexDigitsHi[D]
      else
        C := HexDigitsLo[D];
      Result[I] := C;
    end;
end;

function RandomHexB(const Digits: Integer; const UpperCase: Boolean): UTF8String;
var
  I : Integer;
  D : Integer;
  C : UTF8Char;
begin
  if Digits <= 0 then
    begin
      Result := '';
      exit;
    end;
  SetLength(Result, Digits);
  for I := 1 to Digits do
    begin
      D := 1 + RandomUniform(16);
      if UpperCase then
        C := HexDigitsHiA[D]
      else
        C := HexDigitsLoA[D];
      Result[I] := C;
    end;
end;

function RandomHexU(const Digits: Integer; const UpperCase: Boolean): UnicodeString;
var
  I : Integer;
  D : Integer;
  C : WideChar;
begin
  if Digits <= 0 then
    begin
      Result := '';
      exit;
    end;
  SetLength(Result, Digits);
  for I := 1 to Digits do
    begin
      D := 1 + RandomUniform(16);
      if UpperCase then
        C := HexDigitsHiU[D]
      else
        C := HexDigitsLoU[D];
      Result[I] := C;
    end;
end;

function RandomUpperAlphaStrB(const Length: Integer): UTF8String;
var
  I : Integer;
begin
  if Length <= 0 then
    begin
      Result := '';
      exit;
    end;
  SetLength(Result, Length);
  for I := 1 to Length do
    Result[I] := AnsiChar(Ord('A') + RandomUniform(26));
end;

const
  Vowels         = 'AEIOUY';
  VowelCount     = Length(Vowels);
  Consonants     = 'BCDFGHJKLMNPQRSTVWXZ';
  ConsonantCount = Length(Consonants);

function RandomPseudoWordB(const Length: Integer): UTF8String;
var
  I, A, P, T : Integer;
begin
  if Length <= 0 then
    begin
      Result := '';
      exit;
    end;
  SetLength(Result, Length);
  P := -1;
  A := RandomUniform(2);
  for I := 1 to Length do
    begin
      case A of
        0 : Result[I] := AnsiChar(Vowels[RandomUniform(VowelCount) + 1]);
        1 : Result[I] := AnsiChar(Consonants[RandomUniform(ConsonantCount) + 1]);
      end;
      T := A;
      if A = P then
        A := A xor 1
      else
        A := RandomUniform(2);
      P := T;
    end;
end;

const
  PasswordSymbolChars = '!?@%$&-*#';
  PasswordSymbolCharCount = Length(PasswordSymbolChars);
  PasswordNumberChars = '0123456789';
  PasswordNumberCharCount = Length(PasswordNumberChars);

function RandomPasswordB(const MinLength, MaxLength: Integer;
         const CaseSensitive, UseSymbols, UseNumbers: Boolean): UTF8String;
var
  I, J, K, N, Length : Integer;
  C : AnsiChar;
begin
  if (MaxLength <= 0) or (MaxLength < MinLength) then
    begin
      Result := '';
      exit;
    end;
  if MinLength = MaxLength then
    Length := MinLength
  else
    Length := MinLength + RandomUniform(MaxLength - MinLength + 1);
  Result := RandomPseudoWordB(Length);
  if CaseSensitive then
    begin
      N := RandomUniform(1 + Length div 2);
      for I := 0 to N - 1 do
        begin
          J := RandomUniform(Length);
          C := Result[J + 1];
          if C in ['A'..'Z'] then
            Result[J + 1] := AnsiChar(Ord(C) + 32);
        end;
    end;
  if UseSymbols then
    begin
      N := RandomUniform(1 + Length div 4);
      for I := 0 to N - 1 do
        begin
          J := RandomUniform(Length);
          K := RandomUniform(PasswordSymbolCharCount);
          Result[J + 1] := AnsiChar(PasswordSymbolChars[K + 1]);
        end;
    end;
  if UseNumbers then
    begin
      N := RandomUniform(1 + Length div 4);
      for I := 0 to N - 1 do
        begin
          J := RandomUniform(Length);
          K := RandomUniform(PasswordNumberCharCount);
          Result[J + 1] := AnsiChar(PasswordNumberChars[K + 1]);
        end;
    end;
end;



{                                                                              }
{ Normal Random                                                                }
{                                                                              }
var
  HasRandomNormal : Boolean = False;
  ARandomNormal   : Extended;

function RandomNormalF: Extended;
var
  fac, r, v1, v2: Extended;
begin
  if not HasRandomNormal then
    begin
      Repeat
        v1 := 2.0 * RandomFloat - 1.0;
        v2 := 2.0 * RandomFloat - 1.0;
        r := Sqr(v1) + Sqr(v2);
      Until r < 1.0;
      fac := Sqrt(-2.0 * ln(r) / r);
      ARandomNormal := v1 * fac;
      Result := v2 * fac;
      HasRandomNormal := True;
    end
  else
    begin
      Result := ARandomNormal;
      HasRandomNormal := False;
    end;
end;

procedure RandomNormalFinalise;
begin
  if HasRandomNormal then
    ARandomNormal := 0.0;
end;



{                                                                              }
{ Test cases                                                                   }
{                                                                              }
{$IFDEF DEBUG}
{$IFDEF TEST}
{$ASSERTIONS ON}
procedure Test;
var I, L : Integer;
    A, B, C, D : Word32;
    V, W : Int64;
    T1, T2 : Int64;
begin
  Assert(Length(RandomPasswordB(0, 0, True, True, True)) = 0);
  Assert(Length(RandomPasswordB(1, 1, True, True, True)) = 1);
  for I := 1 to 100 do
    begin
      L := Length(RandomPasswordB(5, 16, True, True, True));
      Assert((L >= 5) and (L <= 16));
    end;
  Assert(Length(RandomHexB(32)) = 32);
  // RandomSeed/RandomUniform
  // - Check for unique numbers
  // - Check average value of random numbers
  T1 := 0;
  T2 := 0;
  for I := 1 to 10000 do
    begin
      A := RandomSeed32;
      B := RandomSeed32;
      C := RandomSeed32;
      D := RandomSeed32;
      Assert(not ((A = B) and (B = C) and (C = D)), 'RandomSeed');
      T1 := T1 + A + B + C + D;
      A := RandomUniform32;
      B := RandomUniform32;
      C := RandomUniform32;
      D := RandomUniform32;
      Assert(not ((A = B) and (B = C) and (C = D)), 'RandomUniform');
      T2 := T2 + A + B + C + D;
    end;
  T1 := T1 div 40000;
  Assert((T1 > $50000000) and (T1 < $B0000000), 'RandomSeed');
  T2 := T2 div 40000;
  Assert((T2 > $50000000) and (T2 < $B0000000), 'RandomUniform');
  // RandomInt64
  // - Check sign
  I := 0;
  repeat
    Inc(I);
    V := RandomInt64;
    W := RandomInt64;
  until ((V < 0) and (W > 0)) or (I = 32);
  Assert((V < 0) and (W > 0), 'RandomInt64');
end;
{$ENDIF}
{$ENDIF}



initialization
  InitStartupSeed;
finalization
  RandomSeedFinalise;
  moaFinalise;
end.