Подбор слагаемых для нужной суммы
Не очень частый, но и не экзотический случай. На моих тренингах такой вопрос задавали не один и не два раза :) Суть в том, что мы имеем конечный набор каких-то чисел, из которых надо выбрать те, что дадут в сумме заданное значение.
В реальной жизни эта задача может выглядеть по-разному.
- Например, мы выгрузили из интернет-банка все платежи, которые поступили на наш счет за последний месяц. Один из клиентов разбивает сумму своего платежа на несколько отдельных счетов и платит частями. Мы знаем общую сумму оплаты и количество счетов, но не знаем их сумм. Надо подобрать те суммы в истории платежей, которые дадут в общем заданное значение.
- У нас есть несколько рулонов стали (линолеума, бумаги...), из которых надо подобрать под заказ те, что дадут заданную длину.
- Блэкджек или в народе "очко". Надо набрать карты суммарной стоимостью максимально близкой к 21 баллу, но не превысить этот порог.
В некоторых случаях может быть известна разрешенная погрешность допуска. Она может быть как нулевой (в случае подбора счетов), так и ненулевой (в случае подбора рулонов), или ограниченной снизу или сверху (в случае блэкджека).
Давайте рассмотрим несколько способов решения такой задачи в Excel.
Способ 1. Надстройка Поиск решения (Solver)
Эта надстройка входит в стандартный набор пакета Microsoft Office вместе с Excel и предназначена, в общем случае, для решения линейных и нелинейных задач оптимизации при наличии списка ограничений. Чтобы ее подключить, необходимо:
- в Excel 2007 и новее зайти Файл - Параметры Excel - Надстройки - Перейти (File - Excel Options - Add-ins - Go)
- в Excel 2003 и старше - открыть меню Сервис - Надстройки (Tools - Add-ins)
и установить соответствующий флажок. Тогда на вкладке или в меню Данные (Data) появится нужная нам команда.
Чтобы использовать надстройку Поиск решения для нашей задачи необходимо будет слегка модернизировать наш пример, добавив к списку подбираемых сумм несколько вспомогательных ячеек и формул:
- Диапазон A1:A20 содержит наши числа, из которых мы будем выбирать нужные, чтобы "вписаться" в заданную сумму.
- Диапазон В1:B20 будет своего рода набором переключателей, т.е. будет содержать нули или единички, показывая, отбираем мы данное число в выборку или нет.
- В ячейке E2 стоит обычная автосумма всех единичек по столбцу B, подсчитывающая кол-во выбранных чисел.
- В ячейке E3 с помощью функции СУММПРОИЗВ (SUMPRODUCT) считается сумма попарных произведений ячеек из столбцов А и B (то есть A1*B1+A2*B2+A3*B3+...). Фактически, здесь подсчитывается сумма чисел из столбца А, отобранных единичками из столбца В.
- В розовую ячейку E4 пользователь вводит желаемую сумму для подбора.
- В ячейке E5 вычисляется абсолютное по модулю значение погрешности подбора с целью ее будущей минимизации.
- Все желтых ячейках Е8:E17 хотелось бы получить список отобранных чисел, т.е. тех чисел из столбца А, напротив которых в столбце В есть единички. Для этого необходимо выделить сразу все (!) желтые ячейки и в них ввести вот такую формулу массива:
=ЕСЛИОШИБКА(ИНДЕКС($A$1:$A$20;НАИМЕНЬШИЙ(ЕСЛИ(B1:B20=1;СТРОКА(B1:B20);"");СТРОКА()-СТРОКА($E$8)+1));"")
=IFERROR(INDEX($A$1:$A$20;SMALL(IF(B1:B20=1;ROW(B1:B20);"");ROW()-ROW($E$8)+1));"")
После ввода формулы ее необходимо ввести не как обычную формулу, а как формулу массива, т.е. нажать не Enter, а Ctrl+Shift+Enter. Похожая формула используется в примере о ВПР, выдающей сразу все найденные значения (а не только первое).
Теперь перейдем на вкладку (или в меню) Данные и запустим инструмент Поиск решения (Data - Solver):
В открывшемся окне необходимо:
- Задать как целевую функцию (Target Cell) - ячейку вычисления погрешности подбора E5. Чуть ниже выбрать опцию - Минимум, т.к. мы хотим подобрать числа под заданную сумму с минимальной (а лучше даже нулевой) погрешностью.
- В качестве изменяемых ячеек переменных (Changing cells) задать диапазон столбца переключателей B1:B20.
- С помощью кнопки Добавить (Add) создать дополнительное условие на то, что ячейки диапазона B1:B20 должны быть бинарными (т.е. содержать только 0 или 1):
- С помощью той же кнопки, при необходимости, создать ограничение на количество чисел в выборке. Например, если мы знаем, что сумма была разбита на 5 счетов, то:
После ввода всех параметров и ограничений запускаем процесс подбора кнопкой Найти решение (Solve). Процесс подбора занимает от нескольких секунд до нескольких минут (в тяжелых случаях) и заканчивается появлением следующего окна:
Теперь можно либо оставить найденное решение подбора (Сохранить найденное решение), либо откатиться к прежним значениям (Восстановить исходные значения).
Необходимо отметить, что для такого класса задач существует не одно, а целое множество решений, особенно, если не приравнивать жестко погрешность к нулю. Поэтому запуск Поиска решения с разными начальными данными (т.е. разными комбинациями 0 и 1 в столбце В) может приводить к разным наборам чисел в выборках в пределах заданных ограничений. Так что имеет смысл прогнать эту процедуру несколько раз, произвольно изменяя переключатели в столбце В.
Найденные комбинации можно сохранять виде сценариев (кнопка Сохранить сценарий), чтобы вернуться к нем позднее с помощью команды Данные - Анализ "что-если" - Диспетчер сценариев (Data - What-If Analysis - Scenario Manager):
И весьма удобно будет вывести все найденные решения, сохраненные в виде сценариев, в одной сравнительной таблице с помощью кнопки Отчет (Summary):
Способ 2. Макрос подбора
В этом способе всю работу делает макрос, который тупо перебирает случайные комбинации чисел, пока не наткнется на нужную сумму в пределах разрешенной погрешности. Добавлять столбец с нулями и единичками и формулы в этом случае не нужно.
Для использования макроса нажмите сочетание Alt+F11, в открывшемся окне редактора Visual Basic вставьте новый модуль через меню Insert - Module и скопируйте туда этот код:
Sub Combinator()
Dim Data() As Variant, Selected() As Variant
Dim goal As Double, sel_count As Integer, prec As Double
Const LIMIT = 1000000
prec = Range("D5").Value
sel_count = Range("D2").Value
goal = Range("D4").Value
Set OutRange = Range("D8")
Set InputRange = Range("A1", Range("A1").End(xlDown))
input_count = InputRange.Cells.Count
Data = InputRange.Value
ReDim Selected(1 To sel_count) As Variant
NewTry:
For j = 1 To sel_count
Start:
RandomIndex = Int(Rnd * input_count + 1)
RandomValue = Data(RandomIndex, 1)
'начиная со второго элемента дополнительно проверяем, чтобы такой уже не был выбран
If j > 1 Then
For k = 1 To j - 1
If Selected(k) = RandomValue Then GoTo Start
Next k
End If
Selected(j) = RandomValue
Next j
If Abs(WorksheetFunction.Sum(Selected) - goal) <= prec Then
Range("D3").Value = WorksheetFunction.Sum(Selected)
MsgBox "Подбор завершен. Необходимая точность достигнута."
Range(OutRange, OutRange.End(xlDown)).ClearContents
OutRange.Resize(sel_count, 1).Value = Application.Transpose(Selected)
Exit Sub
Else
iterations = iterations + 1
If iterations > LIMIT Then
MsgBox "Достигнут лимит попыток. Решение не найдено."
Exit Sub
Else
GoTo NewTry
End If
End If
End Sub
Аналогично первому способу, запуская макрос несколько раз, можно получать разные наборы подходящих чисел.
P.S. Сейчас набегут энтузиасты с мехмата МГУ с криками "Тупой перебор - это неэстетично!" Да, я в курсе, что прямой перебор вариантов - это не самый оптимальный способ поиска. Да, существует много умных алгоритмов поиска решения таких задач, которые сокращают время поиска и находят нужную комбинацию заметно быстрее. Могу даже рассказать про парочку. Но мне на данном этапе существующей скорости "тупого перебора" вполне достаточно - обработка массива из 1000 ячеек идет меньше секунды. Готов подождать :)
Ссылки по теме
- Оптимизация бизнес-модели с помощью надстройки Поиск решения (Solver)
- Что такое макросы, куда и как вставлять код макросов на VBA
P.S.: я не с мехмата МГУ
PPS: мне кажется не хватает Randomize в макросе
Вот такой макрос, при сохранении принципа "перебора", работает существенно быстрее (проверил на миллион итераций, когда искомое значение заведомо не будет найдено, у меня работает в 5 раз быстрее), за основу взял текущий макрос:
Sub Combinator2() Dim Data() As Variant, goal As Double, sel_count As Integer, prec As Double, t As Single, AddSum As Double Const LIMIT = 1000000 Randomize prec = Range("D5").Value sel_count = Range("D2").Value goal = Range("D4").Value Set OutRange = Range("D8") Set InputRange = Range("A1", Range("A1").End(xlDown)) input_count = InputRange.Cells.Count Data = InputRange.Value t = Timer Do AddSum = 0 For j = 1 To sel_count RandomIndex = Int(Rnd * (input_count - j + 1) + j) RandomValue = Data(RandomIndex, 1) AddSum = AddSum + RandomValue Data(RandomIndex, 1) = Data(j, 1) Data(j, 1) = RandomValue Next j If Abs(AddSum - goal) <= prec Then Range("D3").Value = AddSum Debug.Print Timer - t, iterations MsgBox "Подбор завершен. Необходимая точность достигнута." Range(OutRange, OutRange.End(xlDown)).ClearContents OutRange.Resize(sel_count, 1).Value = Data Exit Sub End If iterations = iterations + 1 Loop While iterations <= LIMIT Debug.Print Timer - t MsgBox "Достигнут лимит попыток. Решение не найдено." End Subа , для меня не понятен (много букаф)
По указанной Вами ссылки есть только описания, как можно решать, без детального разбора алгоритмов и возможных оптимизаций. Хотелось бы ознакомится с реально работающими вариантами, оптимизированных по скорости, не обязательно на VBA.
Хотел сделать по Вашей статье (Способ 1. Надстройка Поиск решения (Solver)) через массив, но в "Параметрах поиска решений", при добавлении дополнительных условий, не могу установить "бинарный". Уже пробовал вместо равно - поставить функцию "бин", но при нажатии "сохранить" выскакивает ошибка: "Ссылка на ячейки бинарного ограничения должна включать только ячейки переменных"
Что не так?
Прекрасная вещь! Только одного она, к сожалению делать не умеет - раскладывать по ящикам... Как ее научить делать следующие:
1) Список чисел для нахождения слагаемых - вес каждого пакета
2) Рядом столбец номера пакета
3) В ящик помещается (допустим) 5 пакетов
4) Все ящики, укомплектованные по 5 пакетов, должны весить заданное число
Решением задачи является список (все возможные, не повторяющиеся комплекты) по пять (6 или 7....) номеров пакетов, которые весят заданную величину.
Поэтому сказать, что первый способ работаем мгновенно я не могу)
Например есть покупки:
3439
7325
15810
6000
2520
2500
2645
Банк готов вернуть заданную сумму 10000 р но не более
Найти наборы чисел которые максимально наберут наибольшую сумму.
Имеется: набор (1 столбик) слагаемых и набор (1 столбик) чисел. Необходимо набор слагаемых раскидать по суммам без повторов, т.е. есть слагаемые 1,2,3,4 и набор чисел 5, 6. Желаемый в данной ситуации результат будет выглядеть как 5 = 2 + 3 с погрешностью 0, а 6 = 1 + 4 с погрешностью 1. Как это реализовать в нашем любимом экселе?
Подскажите пожалуйста, как решить такую же задачу, но с групами значений. Для каждой группы есть свой набор слагаемых и своя сума. Например для яблок ( 2, 3,5,7,10) сума 12, для груш ( 11, 7,1,3,4) сума 14.
Может есть решение с помощу power query?
Помогите, пожалуйста, решить задачку.
Дано:
реестр с мелкотоннажным (М) транспортом, (тоннаж, тип груза, территориальная принадлежность, дата и время разгрузки)
реестр с большегрузным (Б) транспортом, (тоннаж, тип груза, территориальная принадлежность, дата и время разгрузки)
Необходимо разложить М в Б таким образом, чтобы сумма М не превышала тоннаж Б, но при этом была с минимально возможной погрешностью, а так же:
а) тип груза и территориальная принадлежность Б = М
б) дата и время разгрузки М < дата и время разгрузки Б + 5 часов
в) подбор подходящих значений осуществляется по принципу FIFO, так как сумма М > суммы Б
Было бы замечательно, если бы в результате решения, получилась "кнопка", при нажатии которой, чудесным образом формировался реестр уже сопоставленных данных с учетом всех перечисленных выше требований.
Возможно ли это сделать в принципе?
Заранее спасибо!
Это же, фактически, разработка целой логистической системы погрузки и маршрутизации.
Только продумайте ТЗ сначала обязательно - без него за такое с расплывчатыми формулировками никто нормальный не возьмется.
Но есть вопрос.
Как ограничить число итераций и задать допустимую погрешность вычислений? То что нашла в параметрах не срабатывает(((
Что-то делаю не так(((
Спасибо