Maximize the Sum

[Golom]

Here's one that I found in an old (1986) book on programming called Programming Pearls by John Bentley

The challenge is; given an array of numeric values such as

31, -41, 59, 26, -53, 58, 97, -93, -23, 84

write a program to find the maximum sum of a sub-array of contiguous values in the array. For example, the maximum sum in the above is the values

59 + 26 + -53 + 58 + 97 = 187

The following is a brute force method written in VB that just computes every possible sum from every possible sub-array. It has performance proportional to N[sup]2[/sup] where N is the number of elements in the array.

CHALLENGE: Can you develop a faster algorithm than this?
(The author gives several in the book and I'll post them later.)

Private Sub Command26_Click()

    Dim X()                         As Long
    Dim cbuf                        As String
    Dim N                           As Long
    Dim UB                          As Long

    ReDim X(999)                    [COLOR=black cyan]' Set the size of the array here[/color]

    [COLOR=black cyan]' This just generates some numbers for you[/color]
    UB = UBound(X)
    cbuf = ""
    For N = 0 To UB
        X(N) = Rnd * 100
        If Rnd(X(N)) <= 0.45 Then X(N) = -2 * X(N)
        cbuf = cbuf & X(N) & ", "
        If (N > 0 And N Mod 10 = 0) Or N = UB Then
            Debug.Print Left(cbuf, Len(cbuf) - 2)
            cbuf = ""
        End If
    Next

    BruteForce X

    MsgBox "Done"
End Sub

Private Sub BruteForce(X() As Long)
    Dim MaxSoFar                    As Long
    Dim Sum                         As Long
    Dim StartAt As Long, EndAt      As Long
    Dim L As Long, I As Long, U As Long, N As Long
    Dim tm                          As Double
    [COLOR=black cyan]' This is the brute force approach.[/color]
    tm = Timer
    N = UBound(X)
    MaxSoFar = 0
    For L = 0 To N
        For U = L To N
            Sum = 0
            For I = L To U
                Sum = Sum + X(I)
                If Sum > MaxSoFar Then
                    MaxSoFar = Sum
                    StartAt = L
                    EndAt = U
                End If
            Next
        Next
    Next
    Debug.Print
    Debug.Print "BRUTE FORCE METHOD"
    Debug.Print UBound(X) + 1 & " Elements"
    Debug.Print MaxSoFar, StartAt, X(StartAt), EndAt, X(EndAt)
    Debug.Print (Timer - tm) & " seconds"
End Sub

Just as an aside ... Bentley in his book says
"... on the computer I usually use (1986), the above takes 1 hour for a 1,000 element array ..."

On mine (2006) it takes 13 seconds.

[small]No! No! You're not thinking ... you're only being logical.
- Neils Bohr[/small]

 

[Skie]

[COLOR=white]Dim Y()
ReDim Y(0)
If X(0) < 0 then booNeg = true
For i = 0 to UBound(X)
    If booNeg then
        If X(i) > 0 then
            booNeg = false
            yCnt = yCnt + 1
            ReDim Preserve Y(yCnt)
        End If
    Else
        If X(i) < 0 then
            booNeg = true
            yCnt = yCnt + 1
            ReDim Preserve Y(yCnt)
        End If
    End If
    Y(yCnt) = y(yCnt) + X(i)
Next

If Y(yCnt) < 0 Then ReDim Preserve Y(yCnt-1)
If y(0) > 0 then intStart = 0 else intStart = 1
intBest = y(intStart)
intTotal = y(intStart)
For i = intStart+1 to UBound(y)
    If booPos = false then intTotal = 0
    If booPos then intTotal = intTotal + y(i-1)
    If y(i-1) + y(i) > 0 then booPos = true else booPos = false
    If intTotal > intBest then intBest = intTotal
Next[/color]

I honestly don't know if this is the best method, or if it's faster than a brute force method. The array X is any random set of numbers in an array. It works for the initial example, but it doesn't work for more complex ones.

When I have some more time, I'll improve it so it works this way:
Y would start off as:
1, -2, 5, -1, 5, -7, 3, -1, 10, -50, 4, -1, 10, -6, 5
Become:
-1, 9, -7, 12, -50, 13, -1
Drop any less than 0 values off the ends and I'd get:
9, -7, 12, -50, 13
Becomes:
14, -50, 13
Can't be reduce for better sums, so best sum = 14.

 

[mmerlinn]

Don't have the time to write and test a program to do this, but it looks to me that a modified Shell Sort algorithm would do the job the fastest.

Reminds me of a challenge I had using Apple Basic back in 1981, years before IBM and Bill Gates woke up to the PC market.

Had a standard routine to do a job on the Apple II+ at that time. Took over 8 hours to do the job. Applied the principles of the Shell Sort algorithm to the problem, and when I finally got the finished routine (over a hundred hours of programming and testing later), I could do the SAME job in 12 seconds (TWELVE SECONDS) flat!!!

And this was on a machine with a 1Mhz processor and 32k of RAM and using ONLY what was available in Apple BASIC (NO calls to any machine language). Supposedly impossible according to Beagle Bros Software, or so they said in their letter to me at the time. However, it worked for me then and still does the job today when I need to fire up that ancient machine.

And I deliberately did NOT say what the problem was that I needed to solve, because one of these days I may post the solution here and see if anyone can figure out what the original problem was. In other words, a backwards kind of a puzzle. And those of you who are not INTIMATELY familiar with the Apple BASIC might find it a real challenge indeed.


mmerlinn

"Political correctness is the BADGE of a COWARD!"

 

[mmerlinn]

Hmmm, just thought of a method of doing this that WORST case speed is the same as the brute force method, while BEST case speed would calculated in nanoseconds. Combined with the principles used by the Shell Sort method, I think the solutions could be blazingly fast even with very very large arrays of numbers, like up into the millions.

I might even try this if I can find the time.


mmerlinn

"Political correctness is the BADGE of a COWARD!"

 

[HarleyQuinn]

I'm normally pretty rubbish when it comes to arrays, so I'm dubious that the code I've come up with does work correctly. It looks like it does on the face of it (and it sorts the 1000 element array in 1-2 seconds, less than a second if you remove the string showing which elements it used) but I am still not 100%. Could you all have a look and see that it does the task in hand correctly please? I used the same code as Golom to generate the array, then pass it to my sub:[white]

Private Sub Command4_Click()
    Dim X()                         As Long
    Dim cbuf                        As String
    Dim N                           As Long
    Dim UB                          As Long

    ReDim X(999)                    ' Set the size of the array here

    ' This just generates some numbers for you
    UB = UBound(X)
    cbuf = ""
    For N = 0 To UB
        X(N) = Rnd * 100
        If Rnd(X(N)) <= 0.45 Then X(N) = -2 * X(N)
        cbuf = cbuf & X(N) & ", "
        If (N > 0 And N Mod 10 = 0) Or N = UB Then
            Debug.Print Left(cbuf, Len(cbuf) - 2)
            cbuf = ""
        End If
    Next
    
    Call TimeTest(X)
    
End Sub

Private Sub TimeTest(X() As Long)
Dim l As Long
Dim q As Long
Dim MaxSum1 As Long
Dim CurrentSum1 As Long
Dim startdate As Date
Dim used As String
Dim tempused As String

startdate = Now

For q = 0 To UBound(X)

    For l = q To UBound(X)
        CurrentSum1 = CurrentSum1 + X(q + (l - q))
        tempused = tempused & X(q + (l - q)) & ","
        If CurrentSum1 > MaxSum1 Then
        MaxSum1 = CurrentSum1
        used = tempused
        End If
    Next l
CurrentSum1 = 0
tempused = ""
Next q

Debug.Print MaxSum1 & " in " & DateDiff("s", startdate, Now) & " seconds using " & used

End Sub

[/white] I know it doesn't work correctly for an array where all of the elements are negative at the moment but if it is correct in other ways I can correct that quite easily. This is just to check the logic really!!

Like I say, I'm not 100% sure that this works (correctly) and would welcome anyone pointing out that it doesn't and why!!!

Cheers

HarleyQuinn
---------------------------------
Get the most out of Tek-Tips, read FAQ222-2244 before posting.

 

[Golom]

Here's a solution from John Bentley. On my machine it solves the problem for an array of 1,000,000 elements in about half a second

[COLOR=white white]Private Sub MaxEndMethod(X() As Long)
Dim MaxSoFar                    As Long
Dim MaxEndingHere               As Long
Dim I                           As Long
Dim tm                          As Double
tm = Timer

For I = LBound(X) To UBound(X)
    MaxEndingHere = IIf(MaxEndingHere + X(I) < 0, 0, MaxEndingHere + X(I))
    If MaxEndingHere > MaxSoFar Then MaxSoFar = MaxEndingHere
Next

MsgBox "MAX ENDING METHOD" & vbCrLf & _
       Format(UBound(X) + 1, "###,##0") & " Elements" & vbCrLf & _
       "Sum = " & MaxSoFar & vbCrLf & _
       "Time: " & Format((Timer - tm), "0.000000") & " seconds"

End Sub
[/color]

[small]No! No! You're not thinking ... you're only being logical.
- Neils Bohr[/small]