Генирируем массив

[Yurik]

Привет всем....
Помогите правильно сгенерировать массив элементов.....ситуация такая есть массив (динамический), т.е. число элементов внем не указанно.....

надо заполнить его случайными числами.....причем так чтобы числа не повторялись....т.е. совпадение с другими элементами не было!


Люди киньте код у кого есть!

Заранее благодарен!

[Rainbow]

Есть еще 3 вопроса
1) ты знаешь размер массива в момент его создания или его дополняешь по ходу проги?
2) в каком диапазоне должны быть случайные числа?
3) Какого типа они - целые?

Вообще, чуть конкретизируй задачу, а то решение "в лоб" может быть неэффективным...

Для генерации случайных чисел есть функция Rnd, которая выдает число от 0 до 1
Для того, чтобы сгенерить ЦЕЛОЕ число из диапазона код должен быть примерно таким:
Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

Пример: Int(10*Rnd + 1) - сгенерит число от 1 до 10

Для динамического массива:
Dim arr() as Long - завели массив
Redim Preserve arr(100) - сделали массив размером в 100 элементов

Заметь, что использовано слово Preserve - оставляет на месте заполненные элементы массива. Если без него вызывать, то все очистит...

По поводу несовпадения... Пробегаться по массиву и сравнивать элементы... Если нашли, то генерить другое число...

Ответь на вопросы, если сам не разберешься, как написать.

[Yurik]

Так сразу отвечаю на вопросы:

1) пусть будет из 20 элементов
2) диапозон задается 2 параметрами (мин и макс число)
3) все числа целые

[areh]

вроде вот так вот будет:

Код: Выделить всё

sub RndArray(ByVal min as integer, ByVal max as integer, ByVal nCount as integer, ByRef arr() as integer)

' min & max - границы диапазона значений
' nCount - количество элементов в массиве
' arr() - массив, который надо заполнить

Randomize()

redim arr(nCount - 1) as integer

dim tmp as integer
dim i as integer
dim j as integer

for i = 0 to nCount-1

begin:

tmp = int((max-min +1 )*rnd) + min

for j = 0 to i - 1
if tmp = arr(j) then goto begin
next j

arr(i) = tmp
next i

end sub


писал без ВБ, так что может где в синтаксисе ошибся...

[Yurik]

2 areh:

Спасибо за помошь все работает была мелкая ошибка, но я исправил!

Код: Выделить всё

Sub RndArray(ByVal min As Integer, ByVal max As Integer, ByVal nCount As Integer, ByRef arr() As Integer)

Randomize Timer

ReDim arr(nCount - 1) As Integer

Dim tmp As Integer
Dim i As Integer
Dim j As Integer

For i = 0 To nCount - 1

begin:

tmp = Int((max - min + 1) * Rnd) + min

For j = 0 To i - 1
If tmp = arr(j) Then GoTo begin
Next j

arr(i) = tmp
Next i

End Sub

[Rainbow]

Да, функция, безусловно будет работать. Но одна вещь в коде мне не очень понравилась. Если можно обойтись без метки, да еще внутри цикла, лучше это сделать. Бует гораздо легче и читать, и отлаживать.

Предлагаю написать функцию, которая будет смотреть, является ли вновь добавляемое число уникальным в массиве:

Код: Выделить всё

Private Function IsUnique(ByRef arr() As Long, ByVal nNumber As Long, ByVal nUpperBound As Long) As Boolean
Dim i As Long
   
    For i = 0 To nUpperBound
        If arr(i) = nNumber Then
            Exit Function
        End If
    Next
   
    IsUnique = True
End Function

Тогда переписываем кусок с основным циклом:

Код: Выделить всё

For i = 0 To nCount - 1
    'генерим числа, пока не найдем уникальное
    Do
        tmp = Int((max - min + 1) * Rnd) + min
    Loop Until IsUnique(arr, tmp, i - 1)
   
    'записываем его
    arr(i) = tmp
Next i

Да, и еще. Зачем Randomize Timer? Там просто скобки были лишние. Убери их и заработает... Он по умолчанию Timer использовать будет.

[Yurik]

Всем спасибо!

[areh]

А я ещё тогда добавлю, что прежде чем функция начнет генерацию массива, необходимо проверить, вдруг диапазон будет из 10 чисел, а в массив надо 20 различных значений занести... произойдет зацикливание, так что ещё надо в начале процедуры вставить одну из двух строк:

[code]
if (max - min + 1) < nCount then

' вариант 1
nCount = max- min +1

' вариант 2
exit sub
end if
/code]

И ещё вариант 3 (как рекомендация по поводу програмирования в целом): переделать процедуру в функцию, и возвращать значения, которым будут соответствовать результаты, напримаер, 1 - ошибка, 0 - всё номально, в более сложных функциях это может очень помогать...

Да, по поводу отдельной функции для проверки уникальности, действительно лучше так сделать, просто у меня это ужасная привычка использовать метки. Кстати, вариант с отдельной функцией ещё и работает быстрее, я проверял используя такой вызов ф-ии:
[code]
For i = 1 To 500
Call RndArray(0, 5000, 1000, a)
Next i
[/code]

время на это потраченно: 22 против 20 секунд...

ну это так, к слову...

[Rainbow]

А я ещё тогда добавлю, что прежде чем функция начнет генерацию массива, необходимо проверить, вдруг диапазон будет из 10 чисел, а в массив надо 20 различных значений занести... произойдет зацикливание

Да, ты абсолютно прав... Надо было об этом подумать...
Есть еще пара замечаний по поводу диапазона и количества элементов. Если количество элементов близко к диапазону, да еще и диапазон большой - ну, например, диапазо=[1, 5000], а размер массива 5003, то будет очень долго выполняться - очень долго будет подбирать уникальный элемент в конце. Поэтому стоит подумать про другой алгоритм.

Если, например, требуется банальная перестановка (то есть размер массива совпадает с размером диапазона), то можно сначала создать упорядоченный массив из чисел. Потом генерить случайное число - это будет номер элемента в массиве. Этот элемент перенести вниз. Проделав так достаточное количество раз получим перемешанный массив...

И ещё вариант 3 (как рекомендация по поводу програмирования в целом): переделать процедуру в функцию, и возвращать значения, которым будут соответствовать результаты, напримаер, 1 - ошибка, 0 - всё номально

Если просто успех-неуспех, то это, конечно Boolean. А вообще, можно да, Enum'чик завести и возвращать значения из него.

Еще, если писать уж по-взрослому, то хорошо бы и ошибки обрабатывать. Ну, хотя бы так:

Код: Выделить всё

Public Sub RndArray(ByVal min As Integer, ByVal max As Integer, ByVal nCount As Integer, ByRef arr() As Integer)
On Error Goto errh
.............
    exit sub
errh:
    m_sError = err.Description
End Sub

А во время вызова что-то вроде такого:

Код: Выделить всё

If not RndArray(...) then
   'показать ошибку
end if

[Cyrax]

... долго будет подбирать уникальный элемент в конце. Поэтому стоит подумать про другой алгоритм.

по поводу другого алгоритма...
можно использовать вспомогательный массив заполненный всеми числами из заданного диапазона... этот массив перемешиваем и выбираем нужное количество элементов для заполнения целевого массива...

Код: Выделить всё

Public Function GenerateArray(ByVal iMin As Long, ByVal iMax As Long, ByVal iCount As Long, ByRef iArray() As Long) As Long
  ReDim iTempArr(1 To (iMax - iMin)) As Long
  ReDim iArray(iCount)
 
  Dim i As Long, j As Long, iRndPos As Long
  ' i, j, вспомогательные переменные
  ' iRndPos - необходима для перемешивания массива
 
  ' проверка на корректность параметров
  If iMax <= iMin Then
    GenerateArray = 0
    Exit Function
  End If
  If iCount < 1 Then
    GenerateArray = 0
    Exit Function
  End If
'-------------------------------------------
 
  For i = iMin To iMax - 1 ' заполняем вспомогательный массив
    iTempArr(i - iMin + 1) = i
  Next
 
  ' перемешиваем вспомогательный массив
  Randomize
  For i = 1 To UBound(iTempArr)
    iRndPos = Int(Rnd * (iMax - iMin) + 1)
    j = iTempArr(i)
    iTempArr(i) = iTempArr(iRndPos)
    iTempArr(iRndPos) = j
  Next i
 
  ' выбираем нужное количество элементов сверху массива iTempArr()
  ' и копируем в iArray()
 
  For i = 1 To iCount
    iArray(i) = iTempArr(i)
  Next i
  GenerateArray = 1
End Function

перемешивание массива отдаю вам на растерзание, так так то, что применено в данном случае - решение в лоб и очень не эффективно

[Rainbow]

Ты знаешь, похоже это самый простой и довольно эффективный алгоритм. Переставлять элементы все равно придется... Перемешивает равномерно... Единственный вариант, который еще есть - это оставлять на месте уже перемещенные элементы и генерить число со все уменьшающимся диапазоном. То есть вот так:

Код: Выделить всё

  Randomize
  For i = 500 To 1 Step -1
    iRndPos = Int(Rnd * i)
    j = iTempArr(i - 1)
    iTempArr(i - 1) = iTempArr(iRndPos)
    iTempArr(iRndPos) = j
  Next i

Вроде бы это эквивалент или точный алгоритм, описанный у Кнута. А он в этих дела мастер. Это данные непровереные

[Cyrax]

черт, я не правильно перемешивание написал (по памяти), упустил одну деталь... по этому-то и равномерное перемешивание получается

этот цикл должен выглядеть так

Код: Выделить всё

' перемешиваем вспомогательный массив
  Randomize
  For i = 1 To UBound(iTempArr)
    iRndPos = Int((UBound(iTempArr) - i + 1) * Rnd + 1) ' изменения в этой строчке
    j = iTempArr(i)
    iTempArr(i) = iTempArr(iRndPos)
    iTempArr(iRndPos) = j
  Next i

[areh]

Ну что, вроде бы всё что можно было предусмотрели и обдумали, может теперь кто-нибудь соберёт всё вместе и полность готовую функцию напишет... чтобы все могли пользоваться...

[mad_Max]

Можно еще использовать коллекцию вместо вспомогательного массива - заполнить ее элементами, а потом выбирать по рандому и сразу же удалять, перемешивание не требуется и вместо трех циклов получим два, но производительность при работе с коллекцией вызывает некоторые сомнения:

Код: Выделить всё

Public Function GenerateArray(ByVal iMin As Long, ByVal iMax As Long, ByVal iCount As Long, ByRef iArray() As Long) As Long
  Dim i As Long, j As Long, iRndPos As Long
 
  If iMax < iMin Or iMax - iMin < Count Or iCount < 1 Then
    GenerateArray = 0
    Exit Function
  End If
 
  Dim uniqCol As Collection
  Set uniqCol = New Collection
  ReDim iArray(1 To iCount)

  For i = 1 To iMax
  uniqCol.Add iMin + i - 1
  Next i
 
  Randomize

  For i = 1 To iCount
    j = Rnd * (uniqCol.Count - 1) + 1
    iArray(i) = uniqCol(j)
    uniqCol.Remove j
  Next i
 
  Set uniqCol = Nothing
  GenerateArray = 1
End Function