Return N个正数中大小为1到L的最大不相交且连续的子集

Question

我试图推广 Paul Hankin 在中提供的算法，使得解决方案不限于每个子集的大小恰好为 L，目标不是最大化总和，而是return 可能具有最大子集的集合。

拼出细节，X是一组N正实数： X={x[1],x[2],...x[N]} where x[j]>=0 for all j=1,...,N.

一个名为 S[i] 的连续子集由到 L 个从位置 n[i] 开始的 X 的连续成员组成，并且结束于位置 n[i]+l-1:

S[i] = {x[j] | j=n[i],n[i]+1,...,n[i]+l-1} = {x[n[i]],x[n[i]+1],...,x[n[i]+l-1]}, where l=1,...,L.

两个这样的子集 S[i] 和 S[j] 如果它们不包含 X.

的任何相同成员，则它们被称为成对不相交（非重叠）

定义每个子集成员的总和：

SUM[i] = x[n[i]]+x[n[i]+1]+...+x[n[i]+l-1]

目标是找到长度范围为 1 to L 的连续且不相交（非重叠）子集 S[1],S[2],...，这些子集尽可能大并覆盖 [=] 的所有 N 个元素11=].

例如，给定 X = {5,6,7,100,100,7,8,5,4,4} 和 L = 4，解是 S[1] = {5,6,7}, S[2] = {100, 100, 7, 8}, and S[3] = {5,4,4} 使得 SUM[1] = 18, SUM[2] = 215, and SUM[3] = 13。虽然总和，无论子集如何，都将始终为 246，但关键是长度范围为 1 to L 的其他子集不会产生比上面提供的更大的 SUM[i]。

非常感谢任何帮助。

Answer 1

稍后我会清理代码，但这是我想出的解决方案。

子 getLargestEvents()

'改编自

的算法

Dim X As Variant
Dim N As Integer
Dim sumOfX As Integer
Dim L As Integer
Dim S As Variant
Dim subsetOfXforS As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim SUM As Variant
Dim sumOfM As Integer
Dim numberOfEvents As Integer
Dim M As Variant
Dim maxSUM As Integer
Dim maxI As Integer
Dim maxJ As Integer
Dim beginningSUM As Variant
Dim endingSUM As Variant

'X is the array of N losses (sorted) by day
X = Array(5, 6, 7, 100, 100, 7, 8, 5, 4, 4, 100, 100, 4, 5, 6, 7, 8)

'N is the number of days of loss in the array X
N = UBound(X)

For i = 0 To N
    sumOfX = sumOfX + X(i)
Next i

'L is the hours clause expressed in days (i.e., L = hours clause / 24)
L = 4

'S is the jagged array of N * ( L - 1 ) subsets of X containing no more than L contiguous days of loss
ReDim S(N, L - 1)

'subsetOfXforS is the array of L - 1 days of X containing j contiguous days of loss and is used to create the jagged array S
ReDim subsetOfXforS(L - 1)

For i = 0 To N
    For j = 0 To L - 1
        If i >= j Then
            For k = 0 To j
                Debug.Print X(i - j + k)
                subsetOfXforS(k) = X(i - j + k)
            Next k
        End If
        S(i, j) = subsetOfXforS
    Next j
Next i

'SUM is the array of summations of the members of S
ReDim SUM(N, L - 1)

For i = 0 To N
    For j = 0 To L - 1
        If i >= j Then
            For k = 0 To UBound(S(i, j))
                If j >= k Then
                    Debug.Print "S(" & i & ", "; j & ")(" & k & ") = " & S(i, j)(k)
                    SUM(i, j) = SUM(i, j) + S(i, j)(k)
                    Debug.Print "SUM(" & i & ", "; j & ") = " & SUM(i, j)
                End If
            Next k
        End If
    Next j
Next i

beginningSUM = SUM
ReDim M(N, 2)
endingSUM = SUM

Do While sumOfM < sumOfX

    maxSUM = 0

    'Determine max value in current array
    For i = 0 To N
        For j = 0 To L - 1
            If i >= j Then
                If beginningSUM(i, j) > maxSUM Then
                    maxSUM = SUM(i, j)
                    maxI = i
                    maxJ = j
                End If
                Debug.Print "beginningSUM(" & i & ", " & j & ") = " & beginningSUM(i, j)
            End If
        Next j
    Next i

    sumOfM = sumOfM + maxSUM
    'Store max value

    M(numberOfEvents, 0) = maxI
    M(numberOfEvents, 1) = maxJ
    M(numberOfEvents, 2) = maxSUM

    Debug.Print "maxI: " & maxI & ", maxJ: " & maxJ & ", maxSUM: " & maxSUM

    'Remove values that can no longer apply
    For i = 0 To N
        For j = 0 To L - 1
            If i >= j Then
                If (maxI - maxJ <= i And i <= maxI) Or (maxI < i And i - j <= maxI) Then
                    endingSUM(i, j) = 0
                    Debug.Print "endingSUM(" & i & ", " & j & ") = " & endingSUM(i, j) & " <- removed"
                Else
                    endingSUM(i, j) = beginningSUM(i, j)
                    Debug.Print "endingSUM(" & i & ", " & j & ") = " & endingSUM(i, j)
                End If
            End If
        Next j
    Next i

    beginningSUM = endingSUM
    numberOfEvents = numberOfEvents + 1
Loop

Debug.Print "Final Event Set"
For a = 0 To numberOfEvents - 1
        Debug.Print "i: " & M(a, 0) & ", j: " & M(a, 1) & ", M: " & M(a, 2)
Next a

结束子

Answer 2

这里有一个更好的解决方案：

 Sub getLargestEvents()

'Algorithm adapted from 

    Dim N As Long 'limit of +2,147,483,647
    Dim X As Variant
    Dim i As Long
    Dim L As Integer
    Dim S As Variant
    Dim j As Integer
    Dim tempS As Variant
    Dim largestEvents As Variant
    Dim numberOfEvents As Long
    Dim sumOfM As Double
    Dim maxSUM As Double
    Dim maxI As Long
    Dim maxJ As Long

    X = Array(5, 6, 7, 100, 100, 7, 8, 5, 4, 4, 100, 100, 4, 5, 6, 7, 8)

   'N is the number of days of loss in the array X
    N = UBound(X)

    'L is the hours clause expressed in days (i.e., L = hours clause / 24)
    L = 4

   'S contains the sums of all events that contain no more than L contiguous days of loss
    ReDim S(L * N, L)

    'Debug.Print "i, j, S(i, j):"
    For i = 1 To N
        For j = 1 To L
            If i >= j Then
                S(i, j) = X(i) + S(i - 1, j - 1)
                'Debug.Print i & ", " & j & ", " & S(i, j)
            End If
        Next j
    Next i

    tempS = S
    ReDim largestEvents(N, 3)

    Do While WorksheetFunction.SUM(S) > 0

        maxSUM = 0
        numberOfEvents = numberOfEvents + 1

        'Determine max value in current array
        For i = 1 To N
            For j = 1 To L
                If i >= j Then
                    If tempS(i, j) > maxSUM Then 'tempS(i, j) > maxSUM Then
                        maxSUM = S(i, j)
                        maxI = i
                        maxJ = j
                    End If
                    'Debug.Print "tempS(" & i & ", " & j & ") = " & tempS(i, j)
                End If
            Next j
        Next i

        sumOfM = sumOfM + maxSUM
        'Store max value

        largestEvents(numberOfEvents, 1) = maxI
        largestEvents(numberOfEvents, 2) = maxJ
        largestEvents(numberOfEvents, 3) = maxSUM

        'Debug.Print "maxI: " & maxI & ", maxJ: " & maxJ & ", maxSUM: " & maxSUM

        'Remove values that can no longer apply
        For i = 1 To N
            For j = 1 To L
                If i >= j Then
                    If (maxI - maxJ < i And i <= maxI) Or (maxI < i And i - j < maxI) Then
                        tempS(i, j) = 0
                        'Debug.Print "tempS(" & i & ", " & j & ") = " & tempS(i, j) & " <- removed"
                    End If
                End If
            Next j
        Next i

        S = tempS

    Loop

    Debug.Print "Start Date, Length, Amount"

    For i = 1 To numberOfEvents
        Debug.Print "start date: " & largestEvents(i, 1) - largestEvents(i, 2) + 1 & ", length: " & largestEvents(i, 2) & ", amount: " & largestEvents(i, 3)
    Next i

End Sub

Function getUserSelectedRange(description As String) As Range
'Code adapted from
'

    Set getUserSelectedRange = Application.InputBox("Select a range of " + description, "Obtain Range Object", Type:=8)

End Function

Return N个正数中大小为1到L的最大不相交且连续的子集

Return the largest disjoint and contiguous subsets ranging from size 1 to L among N positive numbers

algorithm

subset

dynamic-programming

np-hard