# Maximize the Sum

Status
Not open for further replies.

#### Golom

##### Programmer
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.)

Code:
``````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]

Code:
``````[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.

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!"

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!"

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]
Code:
``````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.

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
Code:
``````[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]

Status
Not open for further replies.

Replies
25
Views
192
Replies
19
Views
111
Replies
13
Views
69
Replies
6
Views
70
Replies
21
Views
66