vba - 合計が最大であるが特定の値より小さいサブセット

Question

正の値を持つ配列があります。たとえば、 array= {5,4,4,3.8,2,1.7} の場合、合計が最大で 12 未満の部分配列を見つける必要があります。この場合、{4,4,3.8} になります。

別の ex 配列 {7,4,3,2} この場合、最大合計は 12 で、サブセットは {7,3,2} です

長さが1000を超える非常に大きな配列があるため、アルゴリズムはどうなりますか。このプログラムをVBA Excelで書いています。

ありがとう。

Answer 1

サブシーケンスにこのアルゴリズムを試してください

Sub aargh()
Dim a As Variant
Dim limsum As Double, highestnum As Double
Dim i As Integer, j As Integer
    a = Array(5, 4, 4, 3.8, 2, 1.7)
    limsum = 12

    highestsum = 0
    For i = 0 To UBound(a)
        s = a(i)
        j = i
        Do
            If s > highestsum Then fs = i: ls = j: highestsum = s
            j = j + 1
            If j > UBound(a) Then Exit Do
            s = s + a(j)
        Loop While s <= limsum
    Next i
    MsgBox "subarray (" & fs & "," & ls & ") sum = " & highestsum
End Sub

以下のコメントを含め、サブセットのソリューションを含めるように編集されました

Sub aargh()

    Dim sol(), csol()
    a = Array(7, 4, 3, 2)

    ReDim sol(LBound(a) To UBound(a))
    ReDim csol(LBound(a) To UBound(a))
    limsum = 13
    findsum a, sol, csol, maxsum, limsum
    ss = "array "
    For i = 1 To sol(0)
        ss = ss & sep & a(sol(i))
        sep = ","
    Next i
    MsgBox ss & " sum =" & maxsum
End Sub
Sub findsum(ByRef a, ByRef sol, ByRef csol, ByRef maxsum, ByRef limsum, Optional s = 0, Optional lvl = 1, Optional si = 0)
' recursive sub
    For i = si To UBound(a)
        s = s + a(i)
        csol(lvl) = i ' current solution contains number i
        If s <= limsum Then
            If s > maxsum Then ' we found a sum greater than current max we save it
                maxsum = s
                sol(0) = lvl
                For j = 1 To lvl
                    sol(j) = csol(j)
                Next j
            End If
            If i < UBound(a) Then ' pick another number
                findsum a, sol, csol, maxsum, limsum, s, lvl + 1, i + 1
            End If
        End If
        s = s - a(i)
    Next i
End Sub

配列がソートされている場合 (降順) に最適化されたコード

Sub aargh()

    Dim sol(), csol()
    a = Array(20, 15, 10, 7, 6, 5, 4, 3, 2)

    ReDim sol(LBound(a) To UBound(a))
    ReDim csol(LBound(a) To UBound(a))
    limsum = 13
    findsum a, sol, csol, maxsum, limsum, UBound(a)
    ss = "array "
    For i = 1 To sol(0)
        ss = ss & sep & a(sol(i))
        sep = ","
    Next i
    MsgBox ss & " sum =" & maxsum
End Sub
Sub findsum(ByRef a, ByRef sol, ByRef csol, ByRef maxsum, ByRef limsum, si, Optional s = 0, Optional lvl = 1)
' recursive sub
    For i = si To LBound(a) Step -1
        If s + a(i) > limsum Then Exit For
        s = s + a(i)
        csol(lvl) = i    ' current solution contains number i
        If s <= limsum Then
            If s > maxsum Then    ' we found a sum greater than current max we save it
                maxsum = s
                sol(0) = lvl
                For j = 1 To lvl
                    sol(j) = csol(j)
                Next j
            End If
            If i > LBound(a) Then    ' pick another number
                findsum a, sol, csol, maxsum, limsum, i - 1, s, lvl + 1
            End If
        End If
        s = s - a(i)
        If maxsum = limsum Then Exit For 'exit if exact match
    Next i
End Sub

Answer 2

複数の人がコメントで言及しているように、これはサブセット合計問題の単純なバリエーションです。この正確な問題を解決するには、見つけた最大数が より小さいか等しいことを覚えておく必要があります12。

単純な再帰的アブローチは次のようになります。

list = [...]
N = length of list
dp[ maximum possible sum ][ N ]

f(‌current_sum, index):
  if dp[current_sum][index] is set
    return dp[current_sum][index]
  if index >= N
    if current_sum > 12
       result = 0
    else
       result = current_sum
  else
    result = max( f(current_sum, index+1), f(current_sum+list[index], index+1)
  dp[current_sum][index] = result
  return result

result = f(0,0) // this will return the desired result