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.

[Dax]

Ordentlich formatiert und eventuell um die Möglichkeit erweitert, auch negative Zahlen ziehen zu können, wäre das sicher interessant. Allerdings wäre es vielleicht sinnvoller, anstatt eines Arrays eine Bitcollection (TBits glaube ich heisst die in Delphi) zu verwenden, damit würde der nötige Speicher bei nonunique geachtelt. Dann noch ein vernünftiger Klassenname.. und was wäre direkt was für die OpenSource-Rubrik

[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;

[Apollonius]

Initialize kann man eigentlich streichen, wenn man den entsprechenden Code in den Konstruktor steckt - Delphi erlaubt schließlich auch, den Konstruktor an einer Instanz aufzurufen.

[omata]

Das hatte ich auch gelaubt, aber mit der Methode kann man ein erzeugtes Objekt reinitialisieren.

Edit: Den Kontruktur als Methode aufzurufen ist aber nicht gerade die feine Art.

[Reinhardtinho]

Richtig interessant wird es, wenn man das Lotto-Beispiel genauer betrachtet. Anhand der Statistik, die geführt wird, zeigt sich, dass die Lottozahlen nicht gleichverteilt gezogen werden.

Daraus ergibt sich ein gewichteter Zufall. Beim Lotto wurde die Zahl 49 fast 70 mal öfter gezogen, als die Zahl 16.

Die Methode zur Ziehung gewichteter Zufallszahlen nennt sich glaub ich Monte-Carlo-Methode, wenn ich mich nicht täusche.


Die Links dazu:

Lotto Statistik
Monte Carlo Simulation (Wikipedia)

[Apollonius]

@Omata: Weshalb ist sollte man das nicht tun? Die Sprache bietet es an.

@Reinhardtinho: Dass die Zahlen gleichverteilt gezogen werden, kannst du ja auch nicht erwarten. Das hat erstmal nichts mit gewichtetem Zufall zu tun. Anders wäre das, wenn wir von vornerein sagen, dass die Wahrscheinlichkeit für eine 13 geringer als für andere Zahlen sein soll.
Und die Monte-Carlo-Methode bezeichnet einfach nur eine computergestützte Simulation, bei der (Pseudo-)Zufallszahlen verwendet werden, um die Realität anzunähern.

[xZise]

Die Kugeln bei Lotto sollten aber normalverteilt sein, und es ist klar, dass keine Zahl gleichhäufig gezogen wurde. Vielleicht werden die nächsten 10 Jahre die seltenen Zahlen überholen. Oder es passiert auch nichts in der Verteilung

Zitat von Reinhardtinho:

[..]Beim Lotto wurde die Zahl 49 fast 70 mal öfter gezogen, als die Zahl 16.[...]

Gedankenexperiment: Die Zahl 49 wurde 1*10^100000000 + 70 mal gezogen und die 16 "nur" 1*10^100000000. Ist das dann gleich gewichteter Zufall? Du gehst bei Lotto von der Hypergeometrischen Verteilung aus (Ziehen ohne Zurücklegen). Und die interessiert sich nicht für die Ziffern auf der Kugel. Leider findet Lotto nur Sa und Mi statt, so dass relativ wenige Messwerte dabei sind.
Ein solchen Zufall kannst du einfach nicht berechnen

Sehr interessant: http://www.tipptreffer.de/lotto/lottolangfrist.htm

MfG
xZise

[alzaimar]

Ich muss doch einige gravierende Design- und Ästhetikfehler anmerken:
1. Der Klassenname ist eine Zumutung (Klare verständliche Bezeichner verwenden).
2. Es werden sowohl deutsche als auch englische Bezeichner verwendet (Für eine Sprache und eine Formulierung entscheiden).
3. Die verwendete Methode ist suboptimal, sie kann in Extremfällen sehr lange dauern, wenn nämlich der RNG partout nur bereits gezogene Zahlen liefert.
4. Der Parameter 'Unique' ist überflüssig, denn dann kann ich auch gleich den normalen RNG Random verwenden.

Hier ein wesentlich kompakterer Gegenvorschlag:

Delphi-Quellcode:

type
  ENoMoreNumbers = Exception;
  TUniqueRandomSequenceGenerator = class
  private
    FCounter: Integer;
    FNumberList: array of Integer;
  public
    constructor Create(aStart, aEnde: Integer);
    procedure BuildSequence(aStart, aEnde: Integer);
    function GetNextNumber: Integer;
    function TotalCount: Integer;
    function RemainingCount: Integer;
  end;
implementation

{ TUniqueRandomGenerator }

constructor TUniqueRandomSequenceGenerator.Create(aStart, aEnde: Integer);
begin
  BuildSequence(aStart, aEnde);
end;

procedure TUniqueRandomSequenceGenerator.BuildSequence(aStart, aEnde: Integer);
var
  i, j, tmp: Integer;

begin
  SetLength(FNumberList, aEnde - aStart + 1);
// Zahlenliste erzeugen
  for i := 0 to TotalCount - 1 do
    FNumberList[i] := aStart + i;

// Mischen nach Fisher-Yates
  for i := Low(FNumberList) to High(FNumberList) do begin
    j := i + Random(Length(FNumberList) - i);
    tmp := FNumberList[j];
    FNumberList[j] := FNumberList[i];
    FNumberList[i] := tmp;
  end;
  FCounter := 0;
end;

function TUniqueRandomSequenceGenerator.GetNextNumber: Integer;
begin
  if FCounter < High(FNumberList) then begin
    Result := FNumberList[FCounter];
    Inc(FCounter);
  end
  else raise ENoMoreNumbers.Create('No more numbers');
end;

function TUniqueRandomSequenceGenerator.RemainingCount: Integer;
begin
  Result := TotalCount - FCounter;
end;

function TUniqueRandomSequenceGenerator.TotalCount: Integer;
begin
  Result := Length(FNumberList);
end;

Hintergrund: Ich erzeuge eine Liste aller Zahlen und mische diese Liste dann zufällig. Das verwendete Mischverfahren beweisbar perfekt, ergo liefert die Klasse gleichverteilte Zufallszahlen.