Перебор всех возможных вариантов, оптимизация макроса

@vibo90 · Регистрация: 11.11.2014

Студворк — интернет-сервис помощи студентам

Всем доброго времени суток!
Для калибровки скоринговой карты необходимо сделать подстановку всех возможных вариантов ответов (6 для каждого question) на вопросы (17 штук) путем перебора. Это позволит получить распределение вероятностей для скоринговой карты. Максимальное число различных вариантов ответов может быть 6^17 степени, что равно почти 17 трильйонам операций перебора.

Написал цикл, все работает, но за ночь ноут успел сделать перебор только 100 млн вариантов. Отключить автоматическое вычисление параметров не могу, так как каждому вопросу ВПР-м подтягиваются вероятности и результат пересчитывается.

Как можно ускорить цикл, чтобы получить требуемый результат?

Заранее спасибо за ответ.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Sub t()
 
Const r1& = 4, c1& = 4, r2& = 4, c2& = 19 ' адреса начальных ячеек
 
Dim z1, z2, z3, z4, z5, z6, z7, z8, z9, z10, z11, z12, z13, z14, z15, z16, z17 As Integer
 
Dim t As Date
Debug.Print "start: " & Now()
Sheets("Questions").Select
 
For z1 = r1& To 9
Cells(4, c1&).Value = Cells(z1, c2&).Value
Call tmp_a ' разбрасываем результат по корзинам
For z2 = r1& To 9
Cells(5, c1&).Value = Cells(z2, c2&).Value
Call tmp_a
For z3 = r1& To 9
Cells(6, c1&).Value = Cells(z3, c2&).Value
Call tmp_a
For z4 = r1& To 9
Cells(7, c1&).Value = Cells(z4, c2&).Value
Call tmp_a
For z5 = r1& To 9
Cells(8, c1&).Value = Cells(z5, c2&).Value
Call tmp_a
For z6 = r1& To 9
Cells(9, c1&).Value = Cells(z6, c2&).Value
Call tmp_a
For z7 = r1& To 9
Cells(10, c1&).Value = Cells(z7, c2&).Value
Call tmp_a
For z8 = r1& To 9
Cells(11, c1&).Value = Cells(z8, c2&).Value
Call tmp_a
For z9 = r1& To 9
Cells(12, c1&).Value = Cells(z9, c2&).Value
Call tmp_a
For z10 = r1& To 9
Cells(13, c1&).Value = Cells(z10, c2&).Value
Call tmp_a
For z11 = r1& To 9
Cells(14, c1&).Value = Cells(z11, c2&).Value
Call tmp_a
For z12 = r1& To 9
Cells(15, c1&).Value = Cells(z12, c2&).Value
Call tmp_a
For z13 = r1& To 9
Cells(16, c1&).Value = Cells(z13, c2&).Value
Call tmp_a
For z14 = r1& To 9
Cells(17, c1&).Value = Cells(z14, c2&).Value
Call tmp_a
For z15 = r1& To 9
Cells(18, c1&).Value = Cells(z15, c2&).Value
Call tmp_a
For z16 = r1& To 9
Cells(19, c1&).Value = Cells(z16, c2&).Value
Call tmp_a
 
For z17 = r1& To 9
Cells(20, c1&).Value = Cells(z17, c2&).Value
Call tmp_a
 
Next z17
Next z16
Next z15
Next z14
Next z13
Next z12
Next z11
Next z10
Next z9
Next z8
Next z7
Next z6
Next z5
Next z4
Next z3
Next z2
Next z1
 
Debug.Print "finish: " & Now()
End Sub

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub tmp_a()
 
 
If IsNumeric(Cells(29, 8)) = True Then
If Cells(29, 8).Value < 0.05 Then
Cells(4, 17).Value = Cells(4, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.1 Then
Cells(5, 17).Value = Cells(5, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.15 Then
Cells(6, 17).Value = Cells(6, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.2 Then
Cells(7, 17).Value = Cells(7, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.25 Then
Cells(8, 17).Value = Cells(8, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.3 Then
Cells(9, 17).Value = Cells(9, 17).Value + 1
 
ElseIf Cells(29, 8).Value < 0.35 Then
Cells(10, 17).Value = Cells(10, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.4 Then
Cells(11, 17).Value = Cells(11, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.45 Then
Cells(12, 17).Value = Cells(12, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.5 Then
Cells(13, 17).Value = Cells(13, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.55 Then
Cells(14, 17).Value = Cells(14, 17).Value + 1
 
ElseIf Cells(29, 8).Value < 0.6 Then
Cells(16, 17).Value = Cells(16, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.65 Then
Cells(17, 17).Value = Cells(17, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.7 Then
Cells(18, 17).Value = Cells(18, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.75 Then
Cells(19, 17).Value = Cells(19, 17).Value + 1
 
ElseIf Cells(29, 8).Value < 0.8 Then
Cells(20, 17).Value = Cells(20, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.85 Then
Cells(21, 17).Value = Cells(21, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.9 Then
Cells(22, 17).Value = Cells(22, 17).Value + 1
ElseIf Cells(29, 8).Value < 0.95 Then
Cells(23, 17).Value = Cells(23, 17).Value + 1
ElseIf Cells(29, 8).Value < 1 Then
Cells(24, 17).Value = Cells(24, 17).Value + 1
End If
End If
 
End Sub

@Казанский · 09.07.2015, 11:07

vibo90, путем оптимизации кода можно получить ускорение в 100 раз, но это не спасет ситуацию: если продолжать работу с существующим кодом, потребуется 169266 ночей, а если с оптимизированным - 1700 ночей.
Приложите книгу, где ВПР-м подтягиваются вероятности, может, кто-то что-то предложит.

@vibo90 · 10.07.2015, 11:53 **[ТС]**

Прикрепляю для примера расчетный файл.

@snipe · 10.07.2015, 14:02

наверное так покороче будет
(про скорость не знаю)

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub tmp_a()
Dim i%, j%
If IsNumeric(Cells(29, 8)) = True Then
For i = 24 To 4
m = Choose(i - 3, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 1)
If Cells(29, 8).Value >= m Then
For j = m To 24
Cells(j, 17) = Cells(j, 17) + 1
Next j
Next i
End If
 
End Sub

shanemac51 · 10.07.2015, 15:16

Для калибровки скоринговой карты необходимо сделать подстановку всех возможных вариантов ответов (6 для каждого question) на вопросы (17 штук) путем перебора. Это позволит получить распределение вероятностей для скоринговой карты. Максимальное число различных вариантов ответов может быть 6^17 степени, что равно почти 17 трильйонам операций перебора.

не знаю что такое скоринг-карты
но как зависят ответы на 6 вопрос от ответов на 15-й

вариантов на вопрос 6^6=46656 или около 2 мин
вопросов 17
значит 34 минуты

@vibo90 · 10.07.2015, 16:19 **[ТС]**

Сообщение от snipe

Sub tmp_a() Dim i%, j% If IsNumeric(Cells(29, 8)) = True Then For i = 24 To 4 m = Choose(i - 3, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 1) If Cells(29, 8).Value >= m Then For j = m To 24 Cells(j, 17) = Cells(j, 17) + 1 Next j Next i End If End Sub

Чуть подправил код, но скорости не добавил.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub tmp_a()
Dim i%, j%
If IsNumeric(Cells(29, 8)) = True Then
For i = 24 To 4 Step -1
m = Choose(i - 3, 0, 0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, 0.8, 0.85, 0.9, 0.95)
If Cells(29, 8).Value >= m Then
Cells(i, 17) = Cells(i, 17) + 1
Exit Sub
End If
Next i
End If
 
End Sub

Добавлено через 37 минут

Сообщение от shanemac51

не знаю что такое скоринг-карты
но как зависят ответы на 6 вопрос от ответов на 15-й

shanemac51, предполагается, что зависимостей между вопросами нет. Все 17 вопросов какой то мерой корелируют с вероятностью дефолта заемщика. Каждому из вариантов ответов на вопросы присвоено значение вероятности наступления дефолта на листе Computation столбец G и вероятность наступления дефолта при не наступлении событий (конкретный вопрос). При изменении комбинации ответов меняется значение вероятности дефолта, которое рассчитывается как произведение вероятностей наступления дефолта при условии что собитие Bi (т.е. наш вариант ответа) известно разделенное на произведение вероятностей наступления дефолта когда событие (наш вариант ответа) не произошел, и ни как не повлиял на событие А и умноженый на вероятность дефолта рассчитанную по историческим данным.

Если мы к примеру для первых 10 вопросов дадим ответ а, то на странице Computation в столбцах L и M в место значения 1 будет проставлены соответсвующие вероятности, с которыми варианты ответа влияют на вероятность дефолта. Далее считается произведение по столбцу L, разделяется на произведение по столбцу M и умножается на константу.
В таком случае возможных комбинаций ответов, а соответственно различных PD (cells(29,8)) может быть 6^17.
6 вариантов для каждого вопроса имеют разные рассчетные значения.
Для корректного получения вероятности пользователю нужно дать ответы как минимум на 10 вопросов. Если условие не выполняется результат не рассчитывается.
Спасибо.

@Catstail · 10.07.2015, 16:36

Даже не вникая в суть, можно отметить, что код:

Visual Basic
1
2
3
if (...) Then
  Cells(...).Value=Cells(...).Value+1
...

Будет работать убийственно долго. Лучше вместо cells использовать обычные массивы. При этом соображения Казанского, остаются в силе

@vibo90 · 10.07.2015, 17:09 **[ТС]**

Catstail, но как использовать массив, если конечный результат расчета - одно число, которое размещено в одной ячейке?
Использование немножко модифицированного скрипта Казанского (с использованием цикла) замедлило выполнение запроса.
Мне кажется, для процедуры tmp_a, использование цикла только усугубляет процесс выполнения. Функция Choose обрабатывает каждый вариант в списке, несмотря на то, что возвращает всего один вариант.

@Catstail · 10.07.2015, 18:16

Очень просто: вместо Cells(x,y) писать A(x,y) (где A - массив).

@m-ch · 10.07.2015, 18:19

Какова цель перебора? нужно высчитать вероятность для всех 6^17 возможных вариантов либо какая то другая цель?

Если решается задача оптимизации или нахождения наиболее вероятного устойчивого значения, не приводящего к дефолту, то может решать задачу линейной оптимизации (симплекс методом) инструментарием "Поиск решения" (Solver), встроенного в Excel

@vibo90 · 10.07.2015, 23:13 **[ТС]**

Основная цель - получить график или гистограмму распределения всех возможных вариантов вероятности дефолта от 0 до 1 (PD). Как вариант пробую Random-ом сгенерить несколько десятков тысяч значений от 0 до 6^17. Далее полученные значения перевести в шестиричную систему счисления (так как вариантов всего 6) и посчитать для каждого переведенного кода, преобразованого в конкретный набор вариантов ответа значение PD.

Добавлено через 4 часа 37 минут
Хочу решить вопрос используя случайные числа, но возникает ошибка с переводом больших чисел в двоичную или какую либо другую систему счисления.
Для конвертации использовал функцию конверт (Alex77755). Проверка результата в окне immediate случайного числа дает ошибку overflow. Проблема не возникают с числами, длина строки которых, меньше 10 символов.
? конверт(12345678910,2) выбивает ошибка overflow
Как можно устранить ограничение?
Спасибо.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Function КОНВЕРТ(Число, Система)
Dim Z, O
Dim SIM() As String
SIM = Split("0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V", ",")
Do While Число >= Система
    Z = Число \ Система
    O = Число Mod Система
    КОНВЕРТ = SIM(O) & КОНВЕРТ
    Число = Z
Loop
КОНВЕРТ = SIM(Число) & КОНВЕРТ
End Function

@m-ch · 10.07.2015, 23:32

Сообщение от vibo90

но возникает ошибка с переводом больших чисел в двоичную или какую либо другую систему счисления

А зачем Вам перевод в другую систему счисления?
Генерируйте по отдельности 17 чисел от 1 до 6

@snipe · 11.07.2015, 05:05

может я совсем тупой
но зачем столько вызовов функции?
ведь фактически код макроса ни как не связан с функцией
макрос смотрит на одни ячейки - функция на другие

согласенCatstail - обращение к ячейке (тем более когда обновление экрана включено) дорогое удовольствие по части производительности - массив лучше

Добавлено через 21 минуту
разобрался

Добавлено через 15 секунд
разобрался
точно тупой

@vibo90 · 12.07.2015, 00:02 **[ТС]**

Всем спасибо! Все получилось. Генерирование по отдельности 17 чисел от 1 до 6 как предложил m-ch это пожалуй лучший способ решения моей задачи. Получение выборки в 10 тыс строк и результатов занимает меньше минуты.

@va2243 · 10.10.2015, 18:42

Здраствуйте помогите пожалуйста. Я тут у Вас нашел такой фаил, как перебор всех возможных вариантов слов но там 10 столбцов и 20 строк. Помогите переделать что бы было 15 столбцов и 3 строки

@m-ch · 10.10.2015, 20:36

15x3

@va2243 · 10.10.2015, 20:52

Огромное спасибо. А есть вариант как ускорить вычисления если данные во всех ячейках

@m-ch · 11.10.2015, 10:18

Сообщение от va2243

А есть вариант как ускорить вычисления если данные во всех ячейках

В приложенном файле сами вычисления производятся быстро, медленно производится выгрузка на лист.
Учтите, что 3^15 это 14,3 млн. комбинаций, на лист (в один столбец) они не поместятся, лучше сразу сохранять в файл

@va2243 · 11.10.2015, 10:48

А можно сделать что бы выгружал в microsoft access 2010

Новые блоги и статьи Все статьи Все блоги /
Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .
Реалии Hrethgir 01.03.2026 Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .	Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .

@Казанский 15155 / 6428 / 1731 Регистрация: 24.09.2011 Сообщений: 9,999
	09.07.2015, 11:07
	vibo90, путем оптимизации кода можно получить ускорение в 100 раз, но это не спасет ситуацию: если продолжать работу с существующим кодом, потребуется 169266 ночей, а если с оптимизированным - 1700 ночей. Приложите книгу, где ВПР-м подтягиваются вероятности, может, кто-то что-то предложит. 1

@vibo90 15 / 4 / 1 Регистрация: 11.11.2014 Сообщений: 24
	10.07.2015, 17:09 [ТС]
	Catstail, но как использовать массив, если конечный результат расчета - одно число, которое размещено в одной ячейке? Использование немножко модифицированного скрипта Казанского (с использованием цикла) замедлило выполнение запроса. Мне кажется, для процедуры tmp_a, использование цикла только усугубляет процесс выполнения. Функция Choose обрабатывает каждый вариант в списке, несмотря на то, что возвращает всего один вариант. 0

@Catstail Супер-модератор 38178 / 21113 / 4307 Регистрация: 12.02.2012 Сообщений: 34,716 Записей в блоге: 14
	10.07.2015, 18:16
	Очень просто: вместо Cells(x,y) писать A(x,y) (где A - массив). 1

@m-ch 6180 / 945 / 313 Регистрация: 25.02.2011 Сообщений: 1,381 Записей в блоге: 1
	10.07.2015, 18:19
	Какова цель перебора? нужно высчитать вероятность для всех 6^17 возможных вариантов либо какая то другая цель? Если решается задача оптимизации или нахождения наиболее вероятного устойчивого значения, не приводящего к дефолту, то может решать задачу линейной оптимизации (симплекс методом) инструментарием "Поиск решения" (Solver), встроенного в Excel 0

@snipe 4089 / 1469 / 401 Регистрация: 07.08.2013 Сообщений: 3,671
	11.07.2015, 05:05
	может я совсем тупой но зачем столько вызовов функции? ведь фактически код макроса ни как не связан с функцией макрос смотрит на одни ячейки - функция на другие согласенCatstail - обращение к ячейке (тем более когда обновление экрана включено) дорогое удовольствие по части производительности - массив лучше Добавлено через 21 минуту разобрался Добавлено через 15 секунд разобрался точно тупой 1

@vibo90 15 / 4 / 1 Регистрация: 11.11.2014 Сообщений: 24
	12.07.2015, 00:02 [ТС]
	Всем спасибо! Все получилось. Генерирование по отдельности 17 чисел от 1 до 6 как предложил m-ch это пожалуй лучший способ решения моей задачи. Получение выборки в 10 тыс строк и результатов занимает меньше минуты. 0

@va2243 0 / 0 / 0 Регистрация: 10.10.2015 Сообщений: 3
	10.10.2015, 20:52
	Огромное спасибо. А есть вариант как ускорить вычисления если данные во всех ячейках 0

@va2243 0 / 0 / 0 Регистрация: 10.10.2015 Сообщений: 3
	11.10.2015, 10:48
	А можно сделать что бы выгружал в microsoft access 2010 0

Перебор всех возможных вариантов, оптимизация макроса

Решение