N 개의 양수 중에서 크기 1에서 L까지의 가장 큰 분리되고 연속적인 부분 집합을 반환하십시오.

Question

Maximizing the overall sum of K disjoint and contiguous subsets of size L among N positive numbers에 제공된 Paul Hankin 알고리즘을 일반 크기로 만들려고합니다. 솔루션은 정확히 크기 L 인 각 부분 집합에만 국한되지 않으며 목표는 전체 합계를 최대화하는 것이 아니라 최대한 큰 하위 집합으로 집합을 반환하는 것입니다.

세부 사항을 자세히 설명하면 X은 N 양수로 표시됩니다. X={x[1],x[2],...x[N]} where x[j]>=0 for all j=1,...,N입니다.

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]라는 연속적인 부분 집합 X의L 연속 구성원 위치 n[i]에서 시작 위치 n[i]+l-1에서 종료까지 로 구성되어 있습니다.

과 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 요소는 X입니다. 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

여기에 더 나은 해결책 :

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 

Answer 2

나중에 코드를 정리 하겠지만, 여기에 나와있는 해결책이 있습니다.

하위 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 

최종 하위에서 적응