• Modis
  • Modis
  • Активный участник
  • Откуда: Липецк
  • На форуме с 17 февраля 2008г.
  • Сообщений: 892
  • Спасибо: 14

Тема: Подбор элементов из массива

Есть такая задача: Задан массив (допустим 3 значения - 100, 200, 300) и есть определенное число (допустим - 1000). Как правильно написать кодик, чтобы программа перебирала значения из массива, пока сумма не станет равной моему числу. Причем с таким приоритетом, чтобы меньших значений было минимально. В моем примере должно получиться 300+300+300+100=1000 (как лучший из вариантов.

  • Откуда: Санкт-Петербург
  • На форуме с 24 октября 2008г.
  • Сообщений: 19
  • Спасибо: 0

Re: Подбор элементов из массива

Могу предложить вариант определения наименьшего количества чисел массива ar, составляющих число number.
Обратите внимание на следующее:
1.    Результатом работы функции является общее количество чисел массива ar = 30, 20,10, составляющих число number = 100. Для получения других сведений (например, сколько раз используется число 30) надо внести соответствующие изменения.
2.    Предлагаемая функция для вышеуказанного сочетания number и ar остановится на  варианте 30х3 + 10х1, т.е. 4 числа. Но возможно и другое решение 30х2 + 20х2. Если важно, чтобы разница между самым большим числом и самым малым была возможно меньше, надо добавить этот поиск, используя метод рекурсии. Например: при number = number - 30 = 70 и ar = 20,10 результат 20х3 +10х1, т.е. 4 + 1х30 = 5 чисел, а при number = number - 30х2 = 40 результат 20х2, т.е. 2 + 2х30 = 4 числа. Разница чисел 10, в то время как в 1-м случае 30 - 10 = 20…
3.    Для получения целой и дробной частей частного при делении разработаны свои функции, т.к. соответствующие встроенные не всегда корректно работают.
Sub t()'тестовая
    Dim ar(2) As Integer 'исходный массив
    Dim number% 'исходное число
    Dim n# 'недостающее число в массиве
    Dim nRes As Long 'общеее количество требуемых чисел массива
    'тестовые примеры
        ar(0) = 300: ar(1) = 200: ar(2) = 100
        number = 1050: nRes = 0
'        number = 900: nRes = 0
'        number = 1000: nRes = 0
'        number = 1300: nRes = 0
        n = put_asFewAsPossible_Numbers(ar(), number, nRes)
        If n > 0 Then
            MsgBox "В массиве не хватает числа " & n
        Else
            MsgBox "Понадобилось чисел массива: " & nRes
        End If
End Sub
Function put_asFewAsPossible_Numbers(ar() As Integer, ByVal number%, nRes As Long) As Double
    'сортировка массива ar по убывающей. Если надо...
        Dim arSorted() As Integer
        'в данном случае, чтобы не затуманивать главное, полагаем массив уже отсортирован
    'проверка
        Dim nMin#: nMin = ar(UBound(ar)) 'минимальное число в массиве
        Dim nFraction# 'дробная часть числа
        nFraction = DivisionRemainder(number, nMin)
        If nFraction > 0 Then put_asFewAsPossible_Numbers = nFraction * nMin: Exit Function
    'вместить в число number наименьшее количество чисел массива ar
        Dim nAliquot% 'целая часть числа
        Dim i As Long
        For i = LBound(ar) To UBound(ar)
            nAliquot = DivisionAliquot(number, ar(i)) ' целая часть числа
            number = number - ar(i) * nAliquot
            If number = 0 Then Exit Function
        Next i
End Function
Function DivisionAliquot(number, Optional divisor = 1) As Long
    DivisionAliquot = number / divisor
    If DivisionAliquot * divisor > number Then DivisionAliquot = DivisionAliquot - 1
End Function
Function DivisionRemainder(number, Optional divisor = 1) As Double 'дробная часть частного при делении
    DivisionRemainder = number / divisor - DivisionAliquot(number, divisor)
End Function

  • LeonidSN
  • Активный участник
  • На форуме с 30 мая 2005г.
  • Сообщений: 1,480
  • Спасибо: 5

Re: Подбор элементов из массива

> Timak
3. Для получения целой и дробной частей частного при делении разработаны свои функции, т.к. соответствующие встроенные не всегда корректно работают.

Думаю, если отказываться от использования встроенных арифметических функций деления, то уж отказываться радикально, например:

Option Explicit
'********************************************************************
Sub RemainderTest()
    Dim Remainder As Long
    Dim Divided As Long, Divider As Long
    Divided = 100
    Divider = 7
    Remainder = GetRemainder(Divided, Divider)
    MsgBox Remainder
End Sub
Function GetRemainder(Divided As Long, Divider As Long) As Long
'возвращает остаток от деления
    Dim i As Integer
    i = 0
    Do
        Divided = Divided - Divider
        i = i + 1
    Loop Until (Divided < Abs(Divided))
    GetRemainder = Divider - Abs(Divided)
End Function
'********************************************************************
Sub ResultTest()
    Dim Result As Long
    Dim Divided As Long, Divider As Long
    Divided = 100
    Divider = 7
    Result = GetResult(Divided, Divider)
    MsgBox Result
End Sub
Function GetResult(Divided As Long, Divider As Long) As Long
'возвращает частное от деления
    Dim i As Integer
    i = 0
    Do
        Divided = Divided - Divider
        i = i + 1
    Loop Until (Divided < Abs(Divided))
    GetResult = i - 1
End Function
'********************************************************************