Einzelnen Beitrag anzeigen

Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.685 Beiträge
 
Delphi 11 Alexandria
 
#6

AW: Delphi 11 kein RandomRange für 64-bits?

  Alt 23. Apr 2022, 09:57
Vor Jahren irgendwo gefunden. Es leistete gute Dienste.

Delphi-Quellcode:
var
  vLehmerRandSeed64: Int64 = 0;
  vLehmerMultiplierA64: Int64 = 636413622384679305;
  vLehmerAdditiveConstantC64: Int64 = $1;

procedure SingleAdd(const A: LongWord; const B: LongWord; const CarryIn: LongWord; var Sum: LongWord; var CarryOut: LongWord);
var
  Temp: array [0 .. 1] of LongWord;
begin
  UInt64(Temp) := UInt64(A) + UInt64(B) + UInt64(CarryIn);
  Sum := Temp[0];
  CarryOut := Temp[1];
end;

function LehmerRandom64(ParaLehmerModulesM64: int64): int64;
var
  A: array [0 .. 1] of LongWord;
  B: array [0 .. 1] of LongWord;
  C: array [0 .. 3] of LongWord;
  vAindex: LongWord;
  vBindex: LongWord;
  vCindex: LongWord;
  vTransport: array [0 .. 1] of LongWord;
  vTransport1Index: LongWord;
  vTransport2Index: LongWord;
begin
{$RANGECHECKS OFF}
{$OVERFLOWCHECKS OFF}
  vLehmerRandSeed64 := vLehmerRandSeed64 * vLehmerMultiplierA64;
  vLehmerRandSeed64 := vLehmerRandSeed64 + vLehmerAdditiveConstantC64;
  C[0] := 0;
  C[1] := 0;
  C[2] := 0;
  C[3] := 0;
  Int64(A) := ParaLehmerModulesM64;
  Int64(B) := vLehmerRandSeed64;
  for vBindex := 0 to 1 do
  begin
    vTransport[0] := 0;
    vTransport[1] := 0;
    for vAindex := 0 to 1 do
    begin
      vCindex := vAindex + vBindex;
      Uint64(vTransport) := Uint64(A[vAindex]) * Uint64(B[vBindex]);
      for vTransport1Index := vCindex to 4 - 1 do
      begin
        if vTransport[0] = 0 then
          Break;
        SingleAdd(C[vTransport1Index], vTransport[0], 0, C[vTransport1Index], vTransport[0]);
      end;
      for vTransport2Index := vCindex + 1 to 4 - 1 do
      begin
        if vTransport[1] = 0 then
          Break;
        SingleAdd(C[vTransport2Index], vTransport[1], 0, C[vTransport2Index], vTransport[1]);
      end;
    end;
  end;
  Result := Int64(Pointer(@C[2])^);
{$OVERFLOWCHECKS ON}
{$RANGECHECKS ON}
end;

function RandomRange64(const AFrom, ATo: Int64): Int64;
begin
  if AFrom > ATo then
    Result := LehmerRandom64(AFrom - ATo) + ATo
  else
    Result := LehmerRandom64(ATo - AFrom) + AFrom;
end;
Man muss nur im Hinterkopf haben das erst ab dem zweiten Durchlauf die Zahlen variieren.
Gruß vom KodeZwerg
  Mit Zitat antworten Zitat