Я пытался смоделировать лотерею 649 с помощью подпрограммы VBA.Для розыгрыша лотереи шесть шаров будут отобраны на шариковой машине, в начале будет 49 шаров, каждый с вероятностью выбора 1/49, а после того, как будет выбран первый, остальные 48 шаров будут иметь каждыйВероятность выбора 1/48 и т. Д.
Нет прямой функции VBA для генерации случайных чисел, чтобы интервал не был последовательным;например, первый выбранный номер равен 3, а для выбора второго номера 3 будут недоступны!Таким образом, компьютер должен выбирать из 1, 2, 4, ..., 49.
Ниже приведена подпрограмма, которую я написал, в основном я использовал Int ((UBound (array) - 1 + 1) * Rnd + 1) сначала генерировать случайное число между целочисленными интервалами, но я рассматриваю случайное число только как индекс;например, для выбора второго числа, где у меня осталось вышеуказанное число 48: 1, 2, 4, ..., 49, теперь, если случайное число равно 3 (выбрано от 1 до 48), я фактически получаю 4 длявыбор второго номера, потому что это третий в списке.И Rnd () обеспечивает ничью из равномерного распределения, таким образом, каждое число одинаково вероятно.Это метод, который я использую, чтобы обойти.
Затем я записываю все предыдущие выбранные числа в s1 - s6, а затем делаю их неповторяющимися при последующем выборе номера.
Наконец ясортировка с использованием алгоритма быстрой сортировки, найденного в Функция сортировки массива VBA? с небольшим изменением входного массива.И вывод результатов на пустой лист.
Я также использовал Randomize, чтобы увеличить случайность.Так что все кажется хорошим, я имитирую именно то, что делает машина с мячом: выберите первое число, затем второе ... и, наконец, шестое, без возврата (неповторяющееся), единственное отличие, которое я думаю, будет машина для мячаИстинное случайное число, тогда как VBA - псевдослучайное число.
К моему удивлению, для 100 000 симуляций я использовал Remove Duplicates, а затем 79994 найденных и удаленных дубликатов значений;20006 уникальных ценностей остаются.Теперь я чувствую, что это не надежно.Как у большинства розыгрышей могут быть дубликаты?Пробовал много раз, но одно и то же, много дубликатов.Я не уверен, что пошло не так, если что-то не так с этим дизайном и логикой, или это просто потому, что псевдослучайное число?Спасибо всем!
Вот мой код:
Public k As Long
Sub RNG()
Dim NUMBER(), SELECTION(1 To 100000, 1 To 6)
Dim i As Integer, j As Integer, n As Integer
Dim s1 As Integer, s2 As Integer, s3 As Integer, s4 As Integer, s5 As Integer, s6 As Integer
For k = 1 To 100000
Erase NUMBER
ReDim NUMBER(1 To 49)
For i = 1 To 49
NUMBER(i) = i
Next i
For j = 1 To 6
'generate random number as index and select number based on index
Randomize
random_number = Int((UBound(NUMBER) - 1 + 1) * Rnd + 1)
SELECTION(k, j) = NUMBER(random_number)
'record each selection
Select Case j
Case Is = 1
s1 = SELECTION(k, j)
Case Is = 2
s2 = SELECTION(k, j)
Case Is = 3
s3 = SELECTION(k, j)
Case Is = 4
s4 = SELECTION(k, j)
Case Is = 5
s5 = SELECTION(k, j)
Case Is = 6
s6 = SELECTION(k, j)
End Select
'recreate number 1 to 49 by excluding already-selected numbers
Erase NUMBER
ReDim NUMBER(1 To 49 - j)
n = 0
For i = 1 To 49
Select Case j
Case Is = 1
If i <> s1 Then
n = n + 1
NUMBER(n) = i
End If
Case Is = 2
If i <> s1 And i <> s2 Then
n = n + 1
NUMBER(n) = i
End If
Case Is = 3
If i <> s1 And i <> s2 And i <> s3 Then
n = n + 1
NUMBER(n) = i
End If
Case Is = 4
If i <> s1 And i <> s2 And i <> s3 And i <> s4 Then
n = n + 1
NUMBER(n) = i
End If
Case Is = 5
If i <> s1 And i <> s2 And i <> s3 And i <> s4 And i <> s5 Then
n = n + 1
NUMBER(n) = i
End If
End Select
Next i
Next j
Call QuickSort(SELECTION, 1, 6)
Next k
Range("A1:F" & k - 1).Value = SELECTION
End Sub
Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
'/89926/funktsiya-sortirovki-massiva-vba
Dim pivot As Variant
Dim tmpSwap As Variant
Dim tmpLow As Long
Dim tmpHi As Long
tmpLow = inLow
tmpHi = inHi
pivot = vArray(k, (inLow + inHi) \ 2)
While (tmpLow <= tmpHi)
While (vArray(k, tmpLow) < pivot And tmpLow < inHi)
tmpLow = tmpLow + 1
Wend
While (pivot < vArray(k, tmpHi) And tmpHi > inLow)
tmpHi = tmpHi - 1
Wend
If (tmpLow <= tmpHi) Then
tmpSwap = vArray(k, tmpLow)
vArray(k, tmpLow) = vArray(k, tmpHi)
vArray(k, tmpHi) = tmpSwap
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Wend
If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub