首页 文章

返回N个正数中从大小1到L的最大不相交和连续子集

提问于
浏览
0

我试图概括Paul Hankin在_640672中提供的算法,这样解决方案不仅限于每个子集的大小都是L,并且目标不是最大化总和,而是返回具有最大子集的集合 .

详细说明, X 是一组 N 正实数: X={x[1],x[2],...x[N]} where x[j]>=0 for all j=1,...,N .

一个名为 S[i] 的连续子集由 up to L X 的连续成员组成,从 n[i] 位置开始,到 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 .

如果它们不包含 X 的任何相同成员,则这些子集中的两个 S[i]S[j] 被称为成对不相交(非重叠) .

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

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

目标是找到连续且不相交(非重叠)的子集 S[1],S[2],... ,其长度范围从 1 to L 尽可能大并涵盖 X 的所有 N 元素 .

例如,给定 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] .

任何帮助是极大的赞赏 .

2 回答

  • 0

    我稍后会清理代码,但这是我提出的解决方案 .

    Sub getLargestEvents()

    '算法改编自Maximizing the overall sum of K disjoint and contiguous subsets of size L among N positive numbers

    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
    

    结束子

  • 0

    这是一个更好的解决方案:

    Sub getLargestEvents()
    
    'Algorithm adapted from http://stackoverflow.com/questions/29268442/maximizing-the-overall-sum-of-k-disjoint-and-contiguous-subsets-of-size-l-among
    
        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
    'http://stackoverflow.com/questions/22812235/using-vba-to-prompt-user-to-select-cells-possibly-on-different-sheet
    
        Set getUserSelectedRange = Application.InputBox("Select a range of " + description, "Obtain Range Object", Type:=8)
    
    End Function
    

相关问题