Rambler's Top100
Форум: MS ACCESSVBVBA MS OfficeMS SQL server
Новые сообщения: 0000

Форум: 

Обновить визитку
Участники «Online»
Все участники

 
 

Доброго времени суток, Посетитель!

вид форума:
Линейный форум Структурный форум

тема: А вот опять задачка :)
 
 автор: Lukas   (27.10.2009 в 14:46)   личное сообщение
 
 

VBA функция должна возвращать массив из 16 не повторяющихся целых чисел от 0 до 15, в рандомных комбинациях для каждого вызова функции. (Повторы допускаются, но не подряд)

Я, конечно, наваял "утюжок", но имею сильные подозрения, что должно быть решение красивше.

  Ответить  
 
 автор: Силblч   (27.10.2009 в 15:39)   личное сообщение
 
 

как то так?


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|

  Ответить  
 
 автор: Lukas   (27.10.2009 в 15:53)   личное сообщение
 
 

Ну да. А у меня нормально
rnd16 = Int((16 * Rnd)) ' + 1)
от 0 до 15, не тормозит.
Спасибо, пойду "погоняю" малость.

  Ответить  
 
 автор: Силblч   (27.10.2009 в 15:58)   личное сообщение
 
 

[усмiхаеться в вуса] ну то добре

  Ответить  
 
 автор: Lukas   (27.10.2009 в 16:29)   личное сообщение
 
 

Результаты прогонов:
Цикл Do Loop выполняется:
Макс - 97 раз
Среднее - 35 раз
На одно значение функции.
Наверное, надо от него избавляться?

  Ответить  
 
 автор: Силblч   (27.10.2009 в 16:57)   личное сообщение
 
 

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

?

  Ответить  
 
 автор: Lukas   (27.10.2009 в 17:11)   личное сообщение
 
 


Ну не так-же буквально.
Цикл - то остался, хотя и без операторов цикла.

  Ответить  
 
 автор: Lukas   (27.10.2009 в 17:22)   личное сообщение
 
 

Может как-то так:?

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

  Ответить  
 
 автор: Силblч   (27.10.2009 в 17:59)   личное сообщение
 
 

не ну тебе видней :)

  Ответить  
 
 автор: Lukas   (27.10.2009 в 18:09)   личное сообщение
 
 

Как ни странно, но, несмотря на работу со строками, Arr16() работает почти в 2 раза быстрее, чем g().
Видимо, сказываются "холостые выстрелы" в цикле и Like.
Но, что-то мне подсказывает, что должен быть вариант проще.

  Ответить  
 
 автор: Силblч   (27.10.2009 в 18:28)   личное сообщение
 
 

не, ну мне было просто интересно решить задачку :)
ты просто Монстр оптимизации!

  Ответить  
 
 автор: snipe   (27.10.2009 в 17:59)   личное сообщение
 
 

А проверку?


Повторы допускаются, но не подряд

  Ответить  
 
 автор: Lukas   (27.10.2009 в 18:04)   личное сообщение
 
 

Проверим:

 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

  Ответить  
 
 автор: Силblч   (27.10.2009 в 18:08)   личное сообщение
 
 

красиво! цЫфры!
цифромания захватила мой моск!

  Ответить  
 
 автор: Lukas   (27.10.2009 в 18:15)   личное сообщение
31 Кб.
 
 

Магистр, догадался для чего эта функция нужна?
Хотя вряд-ли. Вы у нас товарисч сурьезный, в баловстве не замеченный.

  Ответить  
 
 автор: Силblч   (27.10.2009 в 18:17)   личное сообщение
 
 

в условиях задачи не было сказано, чтобы догадаться!
я тупо следовал ТЗ!

  Ответить  
 
 автор: Lukas   (27.10.2009 в 18:20)   личное сообщение
 
 

Ну не тупо, а я бы сказал творчески, "с огоньком".


Хочешь дам поиграть?

  Ответить  
 
 автор: Силblч   (27.10.2009 в 18:26)   личное сообщение
 
 

не... спасибо за оказанное доверие.... играть то для игрунов :)

  Ответить  
 
 автор: Lukas   (27.10.2009 в 18:28)   личное сообщение
 
 

  Ответить  
 
 автор: Силblч   (27.10.2009 в 18:50)   личное сообщение
 
 

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
в Гугле стока вариантов

  Ответить  
 
 автор: Lukas   (27.10.2009 в 19:04)   личное сообщение
 
 

Гугель это хорошо.
И довольно таки шустренько.

  Ответить  
 
 автор: Lukas   (27.10.2009 в 19:39)   личное сообщение
 
 

Но и тут не без.
Статистика:
Из 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 вызовов.

  Ответить  
 
 автор: Explorer   (27.10.2009 в 21:44)   личное сообщение
 
 

такая вариабельность в данном случае не нужна - просто не реально и 1000 вариантов "держать" да и 500 будет достаточно

кста, можно еще и "крутить" само игровое поле.

мало кто может абстрагироваться и играть держа цифры "на боку" или вверх ногами.

  Ответить  
 
 автор: Силblч   (27.10.2009 в 22:31)   личное сообщение
 
 

Ванька, я тебя люблю! крепкой мужской дружбой

  Ответить  
 
 автор: Explorer   (27.10.2009 в 22:47)   личное сообщение
 
 

я подобной темой заморачивался когда судоку лабал :)

кстати и сам алгоритм построения рамдомной матрицы мне не кажется оптимальным

можно рандомить только абсцисы и ординаты, в общем-то
матрица 4х4=16 сама выстроится и хранить запросто - хххх * yyyy

  Ответить  
 
 автор: Силblч   (27.10.2009 в 23:04)   личное сообщение
 
 

а у нас отличный кандидат в Президенты появился!
http://www.youtube.com/watch?v=PDXEsmJL1ns

  Ответить  
 
 автор: Explorer   (27.10.2009 в 23:19)   личное сообщение
 
 

чо? не тимошенка разве!

  Ответить  
 
 автор: Lukas   (27.10.2009 в 22:39)   личное сообщение
 
 

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

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

А "завалить" попробовал, прикольно.

  Ответить  
 
 автор: snipe   (28.10.2009 в 06:23)   личное сообщение
 
 

Там в "пятнашках" (если разговор про них) засада была
я еще в 7 классе учился понял это (давно это было)
смысл в том что если при собранном раскладе поменять местами цифры 14 и 15 (т.е. после перемены последняя строка получается 13 15 14) , а потом перемешать игру, то она не собиралась - так что применение функции может привести к нерешаемому варианту.

а про "заваливать" ........хороший пример в решении задачи когда надо расставить 8 ферзей на шахматной доске что - бы они друг друга не били

  Ответить  
 
 автор: Lukas   (28.10.2009 в 15:08)   личное сообщение
 
 

Спасибо, про "засаду" помню.
Да и бес то с ней.
Это-ж просто баловство "для себя", можно сказать "отходы производства".

  Ответить  
 
 автор: snipe   (28.10.2009 в 16:48)   личное сообщение
 
 

да всегда пожалуйста
а вот решить задачку по определению правильного и не правильного расклада в "пятнашках" - чегой-то интересно стало

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

  Ответить  
HiProg.com - Технологии программирования
Rambler's Top100 TopList