Given a list of integers, find the largest sum of a contiguous subsequence
f[l_] := Module[{sl = Flatten@MaximalBy[Subsequences[l], Total]}, {Total[sl], sl}]
f[{1, 2, 3, 4, 5, -1, 7, -4, -2}]
(* {21, {1, 2, 3, 4, 5, -1, 7}} *)
Here is a brute force approach modeled after your initial approach but with Do
rather than For
:
LargestContiguousSum[numbers_List] := Module[{n, mSum, index, sum, y, accumulate},
n = Length[numbers];
accumulate = Accumulate[numbers];
mSum = Max[accumulate];
index = 1;
Do[sum = Max[accumulate[[i ;; n]]] - accumulate[[i - 1]];
If[sum > mSum, mSum = sum; index = i], {i, 2, n}];
y = accumulate[[index ;; n]] - If[index == 1, 0, accumulate[[index - 1]]];
{Max[y], numbers[[index ;; index + Position[y, Max[y]][[1, 1]] - 1]]}]
LargestContiguousSum[{1, 2, 3, 4, 5, -1, 7, -4, -2}]
(* {21,{1,2,3,4,5,-1,7}} *)
Here is a fairly fast method. It uses recursion but could, with work, be made to avoid it. The complexity in worst case is probably O(n^2) due to list copying in the recursion, but again, it could be made to avoid that.
The idea is to split into three sublists. Iterate from the left end, totaling, until the total becomes negative. Do same from the right end. The max sum of consecutives is the largest of:
(i) Accumulation from the left end, up to just preceding the position where the left side sum became negative.
(ii) Accumulation from the right end, up to just following the position where the right side sum became negative.
(iii) A recursive call to handle the subsequence between just after the right sum went negative to just before where the left sum went negative.
I am fairly certain there are further efficiencies to be found, but this seems to work fairly well as it is.
largestConsecSum2[ll_] := Module[
{len = Length[ll], hi, lo, rtot, ltot, max = 0},
hi = len;
rtot = ll[[hi]];
While[rtot > 0 && hi > 1,
hi--;
rtot += ll[[hi]];
];
lo = 1;
ltot = ll[[lo]];
While[ltot > 0 && lo < len,
lo++;
ltot += ll[[lo]];
];
If[hi == 1 && lo == len,
max = Max[Accumulate[ll]],
If[lo > 1,
max = Max[Prepend[Accumulate[ll[[1 ;; lo - 1]]], max]]];
If[hi < len,
max = Max[Prepend[Accumulate[ll[[len ;; hi + 1 ;; -1]]], max]]];
If[lo < hi - 1,
max = Max[{max, largestConsecSum2[ll[[lo + 1 ;; hi - 1]]]}]];
];
max
]
It seems to give the right results, or at least is in agreement with what I believe is the fastest prior answer.
In[115]:= Table[
llbig = RandomInteger[{-100, 100}, n];
t1 = Timing[ls = LargestContiguousSum[llbig]];
t2 = Timing[ls2 = largestConsecSum3[llbig]];
{t1[[1]], t2[[1]], t1[[2, 1]], t2[[2]]}
,
{n, 2^Range[12, 14]}]
(* Out[115]= {{0.032, 0.004, 3125, 3125}, {0.06, 0.012, 6308,
6308}, {0.208, 0.02, 8360, 8360}} *)
I'll give some thought to removing the recursion.
--- edit ---
Here is it made nonrecursive.
largestConsecSum2[ll_] := Module[
{len = Length[ll], hi, lo, rtot, ltot,
max = 0, oldlo = 1, oldhi},
oldhi = len;
j = 0;
While[oldlo <= oldhi, j++;
hi = oldhi;
rtot = ll[[hi]];
While[rtot > 0 && hi > oldlo,
hi--;
rtot += ll[[hi]];
];
lo = oldlo;
ltot = ll[[lo]];
While[ltot > 0 && lo < oldhi,
lo++;
ltot += ll[[lo]];
];
If[hi == oldlo && lo == oldhi,
max = Max[{max, Total[ll[[oldlo ;; oldhi]]]}];
Break[],
If[lo > oldlo,
max = Max[Prepend[Accumulate[ll[[oldlo ;; lo - 1]]], max]]];
If[hi < oldhi,
max =Max[Prepend[Accumulate[ll[[oldhi ;; hi + 1 ;; -1]]], max]]];
If[lo < hi - 1, oldlo = lo + 1; oldhi = hi - 1;
,(*else*)Break[]
];
];
];
max
]
Quite fast now (as in linear time). Sometimes it's good to use pedestrian procedural code.
(* In[195]:= Table[
llbig = RandomInteger[{-100, 100}, n];
Timing[ls2 = largestConsecSum5[llbig]]
,
{n, 2^Range[10, 18]}]
Out[195]= {{0., 1749}, {0.004, 2065}, {0.004, 5653}, {0.012,
4145}, {0.016, 9293}, {0.04, 15855}, {0.08, 15299}, {0.156,
21753}, {0.304, 32417}} *)
--- end edit ---