Zufallszahlen im Bereich Von-Bis, ohne Zurücklegen

[omata]

Delphi-Quellcode:

// Demo
var Zfall: Tzfzozl;
begin
  // Lottozahlen 6 aus 49
  zFall := Tzfzozl.Create(1, 49, 6, true);
  try
    write('Zufallszahlen: ');
    while not zFall.EOF do
      write(zfall.Next:3);
  finally
    zFall.Free;
  end;
  readln;
end.

Delphi-Quellcode:

type
  // Liefert die Zufallszahlen im Bereich Von-Bis ohne zurücklegen
  // Wenn Unique = True, werden keine doppelten Zahlen in den Pool aufgenommen
  // Über Initialize kann eine Neuinitialisierung der Ziehung erfolgen
  Tzfzozl = class    
  strict private
    fArray: array of integer;
    procedure RemoveAndMix(aIndex: Integer);
    function GetCount: integer;
  public
    constructor Create(Von, Bis, Anzahl: Integer; Unique: boolean = false);
    procedure Initialize(Von, Bis, Anzahl: Integer; Unique: boolean = false);
    property Count: integer read GetCount;
    function First: Integer;
    function Next: Integer;
    function EOF: boolean;
  end;

constructor Tzfzozl.Create(Von, Bis, Anzahl: Integer; Unique: boolean = false);
begin
  inherited create;
  Initialize(von, bis, Anzahl, Unique);
end;

procedure Tzfzozl.Initialize(Von, Bis, Anzahl: Integer; Unique: boolean = false);

  function IsXinArr(Bis, X: integer): boolean;
  var i: integer;
  begin
    result := false;
    i:=0;
    while (i <= bis) and not result do
    begin
      if fArray[i] = x then
        result := true;
      inc(i);
    end;
  end;

var i, x: integer;
    canUnique: boolean;
begin
  canUnique := (bis - von >= anzahl);
  setLength(fArray, 0);
  if (bis > von) and CanUnique then
  begin
    setlength(fArray, Anzahl);
    for i := 0 to high(fArray) do
    begin
      if not Unique then
        fArray[i] := random(bis-von+1)+von
      else
      begin
        repeat
          x := random(bis-von+1)+von;
        until not IsXinArr(i-1, x);
        fArray[i] := x;
      end;
    end;
  end;
end;

function Tzfzozl.EOF: boolean;
begin
  result := length(fArray) = 0;
end;

function Tzfzozl.First: Integer;
begin
  if count > 0 then
    result := Next
  else
    result := -1; //-1 wenn fehler aufgetreten
end;

function Tzfzozl.Next: Integer;
var i: integer;
begin
  result := -1;
  if not Eof then
  begin
    i := random(length(fArray));
    result := fArray[i];
    RemoveAndMix(i);
  end;
end;

function Tzfzozl.GetCount: integer;
begin
  result := length(FArray);
end;

procedure Tzfzozl.RemoveAndMix(aIndex: Integer);

  procedure Shuffle;
  var i, x, y: integer;
  begin
    for i := low(fArray)+1 to high(fArray) do
    begin
      y := i + Random(Length(fArray) -i);
      x := fArray[i-1];
      fArray[i-1] := fArray[y];
      fArray[y] := x;
    end;
  end;

var i: integer;
begin
  for i := aIndex + 1 to high(fArray) do
    fArray[i-1] := fArray[i];
  setlength(fArray, high(FArray));
  Shuffle;
end;

initialization
Randomize;