[Visual Basic] x Zahlen aus n Zahlen ziehen: Das Lotto-Problem

[Visual Basic] x Zahlen aus n Zahlen ziehen: Das Lotto-Problem

Eine der am häufigsten gestellten Fragen, welche ich im Internet in diversen Foren gesehen habe, ist die Frage nach einem Algorithmus, welcher Folgendes abbildet:
Ziehung von x Zahlen aus n Zahlen ohne Zurücklegen und ohne Beachtung der Reihenfolge bei x<=n.
In verständliche Alltags-Worte übersetzt: Das berühmte Lotto-Problem.
Nachdem ich dann diverse Antworten, Vorschläge und ähnliches gesehen habe, unter denen auch teilweise, meiner Meinung nach, fürchterliche Algorithmus-Konstruktionen waren, habe ich mich hingesetzt, und selbst einen Algorithmus geschrieben.
Ich stelle meinen Algorithmus zur freien Verfügung. Über Feedback freue ich mich natürlich.
Hinweis: Quicksort wurde 1:1 von www.vbarchiv.net übernommen.
P.S.: Wenn mir jemand Alltags-Beispiele für Variante 2 und 4 nennen könnte, würde ich mich echt freuen. Mir ist absolut nichts dazu eingefallen.
Visual Basic:
'Ziel-Array
Public arrDest() As Long
Sub CallLottery()
  'Aufruf
  Lottery 6, 49, True, False  'ohne Beachtung der Reihenfolge und ohne Zurücklegen (Klassisches Lottospiel)
  Lottery 6, 49, True, True  'ohne Beachtung der Reihenfolge jedoch mit Zurücklegen
  Lottery 6, 49, False, False 'Mit Beachtung der Reihenfolge und ohne Zurücklegen (Tombola - Dritter, zweiter und Erster Platz u.ä.)
  Lottery 6, 49, False, True  'Mit Beachtung der Reihenfolge jedoch mit Zurücklegen (Passwort-Generator)


End Sub
Public Sub Lottery(ByVal DrawNumbers As Long, ByVal TotalNumbers As Long, Optional ByVal Sorted As Boolean = True, Optional ByVal Duplicates As Boolean = False)
Dim arrSource() As Long
Dim i As Long
Dim UpperBound As Long
Dim Counter As Long
Dim RandomNumber As Long

  'Quell und Source-Array gemäss Aufruf neu dimensionieren
  ReDim arrDest(1 To DrawNumbers)
  ReDim arrSource(1 To TotalNumbers)

  'Aufbauen Quell-Array
  For i = 1 To TotalNumbers

  arrSource(i) = i

  Next

  Counter = 0
  UpperBound = TotalNumbers

  'Starte Zufallsgenerator
  Randomize

  Do

  'Ziehe Zufallszahl
  RandomNumber = Int(UpperBound * Rnd + 1)

  Counter = Counter + 1  'Erhöhe Member-Index für Ziel-Array
  'Nimm Zufallszahl als Index für das Quell-Array und weise dessen Wert dem aktuellen Member des Ziel-Arrays zu
  arrDest(Counter) = arrSource(RandomNumber)

  'Wird mit oder ohne Zurücklegen gezogen? Die If-Anweisung  ergibt True falls ohne Zurücklegen gezogen wird
  If Not Duplicates Then

  'Ersetze gezogenes Mitglied des Quell-Arrays mit dem letzten "UpperBound" Mitglied des Quell-Arrays
  arrSource(RandomNumber) = arrSource(UpperBound)

  'Verkleinere "virtuell" das Quell-Array. Bereits gezogene Zahlen verschwinden aus dem Zufalls-Bereich
  'Siehe "Ziehe Zufallszahl"
  UpperBound = UpperBound - 1

  End If

  Loop Until Counter = DrawNumbers

  'Wenn die Reihenfolge egal ist, springe zum sortieren
  If Sorted Then QuickSort arrDest
End Sub
Public Sub QuickSort(vSort As Variant, _
  Optional ByVal lngStart As Variant, _
  Optional ByVal lngEnd As Variant)
  ' Wird die Bereichsgrenze nicht angegeben,
  ' so wird das gesamte Array sortiert
  If IsMissing(lngStart) Then lngStart = LBound(vSort)
  If IsMissing(lngEnd) Then lngEnd = UBound(vSort)
  Dim i As Long
  Dim j As Long
  Dim h As Variant
  Dim x As Variant
  i = lngStart: j = lngEnd
  x = vSort((lngStart + lngEnd) / 2)
  ' Array aufteilen
  Do
  While (vSort(i) < x): i = i + 1: Wend
  While (vSort(j) > x): j = j - 1: Wend
  If (i <= j) Then
  ' Wertepaare miteinander tauschen
  h = vSort(i)
  vSort(i) = vSort(j)
  vSort(j) = h
  i = i + 1: j = j - 1
  End If
  Loop Until (i > j)
  ' Rekursion (Funktion ruft sich selbst auf)
  If (lngStart < j) Then QuickSort vSort, lngStart, j
  If (i < lngEnd) Then QuickSort vSort, i, lngEnd
End Sub
Autor
Zvoni
Aufrufe
1.545
First release
Last update

Bewertungen

0,00 Stern(e) 0 Bewertungen

Share this resource

Zurück