|
|
|
| VBA функция должна возвращать массив из 16 не повторяющихся целых чисел от 0 до 15, в рандомных комбинациях для каждого вызова функции. (Повторы допускаются, но не подряд)
Я, конечно, наваял "утюжок", но имею сильные подозрения, что должно быть решение красивше.
| |
|
| |
|
|
|
| как то так?
Function rnd16()
Randomize
rnd16 = Int((16 * Rnd) + 1) ' а от 15 до 0, почему то "зависает" долго считает ;)
End Function
Function g()
Dim i%, r%
s = "|"
For i = 0 To 15
r = rnd16()
Do While s Like "*|" & r & "|*" And s <> "|": r = rnd16(): Loop
s = s & r & "|"
Next i
g = s
End Function
|
?g()
|10|7|1|4|3|5|12|14|16|13|2|9|6|8|11|15|
|2|15|10|3|9|12|13|14|6|16|5|8|4|7|1|11| | |
|
| |
|
|
|
| Ну да. А у меня нормально
rnd16 = Int((16 * Rnd)) ' + 1)
от 0 до 15, не тормозит.
Спасибо, пойду "погоняю" малость. | |
|
| |
|
|
|
| [усмiхаеться в вуса] ну то добре | |
|
| |
|
|
|
| Результаты прогонов:
Цикл Do Loop выполняется:
Макс - 97 раз
Среднее - 35 раз
На одно значение функции.
Наверное, надо от него избавляться? | |
|
| |
|
|
|
|
Function rnd16()
Randomize
rnd16 = Int((16 * Rnd))
End Function
Function g()
Dim i%, r%
s = "|"
For i = 0 To 15
r = rnd16()
'Do While s Like "*|" & r & "|*" And s <> "|": r = rnd16(): Loop
dodo:
If s Like "*|" & r & "|*" And s <> "|" Then r = rnd16(): GoTo dodo
s = s & r & "|"
Next i
g = s
End Function
|
? | |
|
| |
|
|
|
|
| Может как-то так:?
Public Function Arr16() As Variant
Dim str As String
Dim i As Integer
Dim s As String
Dim Res As String
Const SPL As String = " "
Const ONE As Integer = 1
Randomize
str = "0123456789ABCDEF"
For i = ONE To 16
s = Mid$(str, Rnd() * (Len(str) - ONE) + ONE, ONE)
Res = Res & SPL & Val("&H" & s)
str = Replace(str, s, vbNullString)
Next i
Debug.Print Res
Arr16 = Split(Res, SPL)
End Function
|
| |
|
| |
|
|
|
|
| Как ни странно, но, несмотря на работу со строками, Arr16() работает почти в 2 раза быстрее, чем g().
Видимо, сказываются "холостые выстрелы" в цикле и Like.
Но, что-то мне подсказывает, что должен быть вариант проще. | |
|
| |
|
|
|
| не, ну мне было просто интересно решить задачку :)
ты просто Монстр оптимизации! | |
|
| |
|
|
|
| А проверку?
Повторы допускаются, но не подряд
|
| |
|
| |
|
|
|
| Проверим:
1 7 1 14 9 6 3 15 8 0 4 12 11 5 2 10 13
2 13 4 6 10 8 11 1 14 5 2 9 0 12 3 15 7
3 1 2 11 8 3 9 13 7 5 4 6 10 15 14 0 12
4 8 5 2 10 1 0 14 15 9 4 12 7 3 13 11 6
5 10 7 12 2 5 14 11 9 1 6 0 8 15 4 3 13
6 2 12 4 5 7 9 14 1 8 10 11 15 3 6 13 0
7 5 9 8 1 14 4 10 12 3 7 2 0 13 6 11 15
8 12 11 0 3 15 10 9 4 8 6 14 5 13 1 2 7
9 0 10 5 15 7 9 6 13 4 8 11 3 2 14 12 1
10 3 7 10 12 15 5 1 9 4 8 2 13 11 6 0 14
11 10 9 1 14 2 15 4 13 8 6 11 3 7 5 12 0
12 13 7 5 10 8 12 14 6 3 4 2 1 9 11 15 0
13 5 11 13 12 8 3 0 2 14 7 1 10 6 9 4 15
14 8 9 2 10 1 3 12 13 11 6 7 14 5 0 15 4
15 15 11 8 10 2 7 12 1 0 6 5 4 3 9 13 14
16 3 9 14 7 11 5 6 13 12 4 15 1 2 10 0 8
17 6 7 3 5 2 4 8 11 13 10 9 12 14 1 15 0
18 13 9 10 5 3 12 4 15 1 7 2 11 0 14 6 8
19 0 8 1 5 12 10 15 9 13 6 11 2 4 7 3 14
20 7 11 6 4 13 1 2 0 8 10 9 12 14 5 15 3
21 10 7 12 2 5 14 11 9 1 6 0 8 15 4 3 13
22 2 12 4 5 7 9 14 1 8 10 11 15 3 6 13 0
23 5 9 8 1 14 4 10 12 3 7 2 0 13 6 11 15
24 12 11 0 3 15 10 9 4 8 6 14 5 13 1 2 7
25 0 10 5 15 7 9 6 13 4 8 11 3 2 14 12 1
26 3 7 10 12 15 5 1 9 4 8 2 13 11 6 0 14
27 9 1 6 11 12 0 7 3 5 13 8 15 4 10 14 2
28 12 13 9 5 3 11 1 10 2 14 0 6 8 4 7 15
29 4 1 3 9 7 8 5 2 12 13 11 10 15 0 14 6
30 7 14 6 4 12 2 13 11 3 10 1 9 5 15 8 0
31 14 2 13 6 12 9 0 4 10 8 15 11 5 7 1 3
32 2 15 4 5 7 9 11 14 8 10 6 1 13 3 12 0
33 5 12 8 1 14 4 6 10 3 13 2 9 7 11 0 15
34 12 0 1 4 15 13 8 2 10 9 11 7 6 5 14 3
35 15 12 4 14 6 9 2 10 7 11 3 13 8 0 5 1
36 6 1 12 2 9 4 7 3 14 11 0 8 5 13 10 15
37 9 14 1 13 0 2 15 11 8 10 6 5 4 12 7 3
38 1 3 9 15 2 8 4 6 5 12 10 13 11 0 7 14
39 4 14 12 11 8 5 10 13 9 6 7 15 0 3 1 2
40 11 2 5 14 10 13 12 4 3 8 7 1 6 15 9 0
41 14 15 8 10 2 9 6 0 3 11 4 7 12 5 1 13
42 2 12 14 7 9 6 3 10 13 11 8 5 0 4 1 15
43 9 1 6 11 12 0 7 3 5 13 8 15 4 10 14 2
44 12 13 9 5 3 11 1 10 2 14 0 6 8 4 7 15
45 4 1 3 9 7 8 5 2 12 13 11 10 15 0 14 6
46 7 14 6 4 12 2 13 11 3 10 1 9 5 15 8 0
47 14 2 13 6 12 9 0 4 10 8 15 11 5 7 1 3
48 2 15 4 5 7 9 11 14 8 10 6 1 13 3 12 0
49 4 2 13 12 9 6 8 11 15 0 10 3 7 1 5 14
50 11 6 4 14 9 13 8 1 3 0 7 10 2 5 15 12
|
| |
|
| |
|
|
31 Кб. |
|
| Магистр, догадался для чего эта функция нужна?
Хотя вряд-ли. Вы у нас товарисч сурьезный, в баловстве не замеченный. | |
|
| |
|
|
|
| в условиях задачи не было сказано, чтобы догадаться!
я тупо следовал ТЗ! | |
|
| |
|
|
|
|
| не... спасибо за оказанное доверие.... играть то для игрунов :)
| |
|
| |
|
|
|
|
| Public Function shuffle()
Dim teamArray()
teamArray = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)
arr = ShuffleArrayInPlace(teamArray)
For i = LBound(arr) To UBound(arr)
Debug.Print arr(i)
Next i
End Function
Function ShuffleArrayInPlace(InArray() As Variant)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArrayInPlace
' This shuffles InArray to random order, randomized in place.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
Dim L As Long
Dim temp As Variant
Dim j As Long
Randomize
L = UBound(InArray) - LBound(InArray) + 1
For N = LBound(InArray) To UBound(InArray)
j = Int((UBound(InArray) - LBound(InArray) + 1) * Rnd + LBound(InArray))
If N <> j Then
temp = InArray(N)
InArray(N) = InArray(j)
InArray(j) = temp
End If
Next N
ShuffleArrayInPlace = InArray
End Function
http://www.mrexcel.com/forum/showthread.php?t=418911
в Гугле стока вариантов | |
|
| |
|
|
|
| Гугель это хорошо.
И довольно таки шустренько. | |
|
| |
|
|
|
| Но и тут не без.
Статистика:
Из 10000 вызовов, Shuffle возвращает в среднем 1186 уникальных значений, а Arr16 2069.
Попробуем так:
Public Function Col16() As Variant
Dim Col As Collection
Dim i As Integer
Dim It As Integer
Dim Arr(0 To 15) As Integer
Set Col = New Collection
For i = 0 To 15
Col.Add CInt(i), CStr(i)
Next i
Randomize
For i = 0 To 15
It = Rnd() * (Col.Count - 1) + 1
Arr(i) = Col.Item(It)
Col.Remove It
Next
Set Col = Nothing
Col16 = Arr
End Function
|
Работает в 2 раза быстрее Arr16, и выдает в среднем 2475 уникальных значений на 10000 вызовов. | |
|
| |
|
|
|
| такая вариабельность в данном случае не нужна - просто не реально и 1000 вариантов "держать" да и 500 будет достаточно
кста, можно еще и "крутить" само игровое поле.
мало кто может абстрагироваться и играть держа цифры "на боку" или вверх ногами. | |
|
| |
|
|
|
| Ванька, я тебя люблю! крепкой мужской дружбой | |
|
| |
|
|
|
| я подобной темой заморачивался когда судоку лабал :)
кстати и сам алгоритм построения рамдомной матрицы мне не кажется оптимальным
можно рандомить только абсцисы и ординаты, в общем-то
матрица 4х4=16 сама выстроится и хранить запросто - хххх * yyyy | |
|
| |
|
|
|
| а у нас отличный кандидат в Президенты появился!
http://www.youtube.com/watch?v=PDXEsmJL1ns
| |
|
| |
|
|
|
|
| Да я в общем-то и не хочу хранить варианты вообще.
Но есть смысл пользовать ту функцию, которая предоставляет больше вариантов.
Можно, конечно, было-бы хранить результаты (чемпион, время, кол-во кликов), тогда варианты поневоле пришлось бы хранить, но лень...
А "завалить" попробовал, прикольно. | |
|
| |
|
|
|
| Там в "пятнашках" (если разговор про них) засада была
я еще в 7 классе учился понял это (давно это было)
смысл в том что если при собранном раскладе поменять местами цифры 14 и 15 (т.е. после перемены последняя строка получается 13 15 14) , а потом перемешать игру, то она не собиралась - так что применение функции может привести к нерешаемому варианту.
а про "заваливать" ........хороший пример в решении задачи когда надо расставить 8 ферзей на шахматной доске что - бы они друг друга не били | |
|
| |
|
|
|
| Спасибо, про "засаду" помню.
Да и бес то с ней.
Это-ж просто баловство "для себя", можно сказать "отходы производства". | |
|
| |
|
|
|
| да всегда пожалуйста
а вот решить задачку по определению правильного и не правильного расклада в "пятнашках" - чегой-то интересно стало
а насчет игрушек - решение задач не связанных с комбинаторикой стандартных модулей...это не развитие ли | |
|
| |