Zufallszahlen im Bereich Von-Bis, ohne Zurücklegen

[grenzgaenger]

Da in letzter Zeit öfters gefragt wird, wie man Zufallszahlen ohne zurücklegen erzeugen kann, eine kleine Klasse welches dies übernimmt.

Beispiel um die Lottozahlen 6 aus 49 zu ermitteln und auszugeben:

Delphi-Quellcode:

//Demo
var
 Zfall: Tzfzozl;
begin
 Randomize;
 //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.

Die zugehörige Klasse ist:

Delphi-Quellcode:

type 
 //Liefert die Zufallszahlen im Bereich Von-Bis ohne zurücklegen
 //Randomize muss zuvor aufgerufen sein
 //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;
  for i := 0 to bis do
   if fArray[i] = x then
   begin
    result := true;
    break;
   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
   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;
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;

das gesamte Programm ist im Anhang beigefügt.

Über den Parameter Unique kann die Erzeugung der Zahlen gesteuert werden, ob diese doppelt auftreten dürfen oder unique sein müssen.

Im Fehlerfall wird ein leeres Array zurückgegeben, bei überschreiten der Grenzen -1.

//Edit: FIndex entfernt, da intern nicht verwendet wird.