I would like to sum all the adjacent values in an array that are different from 0, then replace those values with zero, apart from the first value which should be the sum.
For example having an array with {0,0,0,10,12,5,0,1,2,0}, should transform into {0,0,0,27,0,0,0,3 ,0,0}.
I have a badly formed loop that works, but it isn't great.
l = {0,0,0,10,12,5,0,1,2,0}; SequenceReplace[l, {x__ /; FreeQ[{x}, 0]} :> Sequence @@ (Flatten@{Total[{x}], Table[0, Length[{x}] - 1]})] (* {0, 0, 0, 27, 0, 0, 0, 3, 0, 0} *) The current accepted answer will get terribly slow for larger lists.
The following s/b useful for such cases.
fn=With[{s = Split[#, # != 0 &]}, Flatten[Total[s, {2}]*(UnitVector[Length@#, 1] & /@ s)]] &; A speed comparison:
If speed is important, the following should be much faster than the alternatives:
agglomerate[e_] := Module[ { b = ListCorrelate[{2,-1}, Unitize[e], {-1,1}, 0], a = Accumulate[e], res = ConstantArray[0, Length@e], i = Range[Length[e]] }, res[[Pick[i, Most@b, -1]]] = ListCorrelate[{-1,1}, a[[Pick[i, Rest@b, 2]]], -1, 0]; res ] Your example:
agglomerate[{0,0,0,10,12,5,0,1,2,0}] {0, 0, 0, 27, 0, 0, 0, 3, 0, 0}
Comparison with @kglr's solution:
data = RandomInteger[1, 10^6] RandomInteger[10^5, 10^6]; r1 = agglomerate[data]; //AbsoluteTiming r2 = f2[data]; //AbsoluteTiming r1 === r2 {0.106844, Null}
{1.79474, Null}
True
A variation on ciao's method with comparable speeds:
ClearAll[f1] f1 = With[{s = Split[#, # != 0 &]}, Inner[PadRight[{#}, #2] &, Tr /@ s, Length /@ s, Join]]&; f1 @ {0, 0, 0, 10, 12, 5, 0, 1, 2, 0} {0, 0, 0, 27, 0, 0, 0, 3, 0, 0}
And a faster method:
ClearAll[f2] f2 = With[{s = Internal`CopyListStructure[Split[Unitize@#], #]}, Inner[PadRight[{#}, #2] &, Tr /@ s, Length /@ s, Join]] &; f2 @ {0, 0, 0, 10, 12, 5, 0, 1, 2, 0} {0, 0, 0, 27, 0, 0, 0, 3, 0, 0}
SeedRandom[1] rs = RandomInteger[5, 10000]; Equal @@ Through[{f1, f2, fn}@rs] True
Needs["GeneralUtilities`"] BenchmarkPlot[{fn, f1, f2}, Range, Joined -> True, ImageSize -> Large, PlotLegends -> {"fn", "f1", "f2"}] 
Finally, a method using SequenceSplit (slow for long lists but worth considering):
ClearAll[f0] f0 = Join @@ SequenceSplit[#, {a : Except[0] ..} :> PadRight[{+a}, Length@{a}]] &; f0 @ {0, 0, 0, 10, 12, 5, 0, 1, 2, 0} {0, 0, 0, 27, 0, 0, 0, 3, 0, 0}
list = {0,0,0,10,12,5,0,1,2,0}; Replace[ Split[list, #2 != 0 && #1 != 0 &], a : {_, __} :> {Total[a], Table[0, Length[a] - 1]}, 1] // Flatten {0, 0, 0, 27, 0, 0, 0, 3, 0, 0}
Using FoldPairList:
Clear[accbins] accbins[k_List] := Reverse@FoldPairList[ Which[ #1 != 0 && #2 != 0, {0, #1 + #2} , True, {#1, #2} ] & , Reverse[{0}~Join~k] ] list = {0, 0, 0, 10, 12, 5, 0, 1, 2, 0}; accbins@list {0, 0, 0, 27, 0, 0, 0, 3, 0, 0}
Comparison using @kglr 's code and functions:
f1 = With[{s = Split[#, # != 0 &]}, Inner[PadRight[{#}, #2] &, Tr /@ s, Length /@ s, Join]] &; f2 = With[{s = Internal`CopyListStructure[Split[Unitize@#], #]}, Inner[PadRight[{#}, #2] &, Tr /@ s, Length /@ s, Join]] &; SeedRandom[1]; rs = RandomInteger[5, 10000]; (First@#@rs // AbsoluteTiming)[[1]] & /@ {f1, f2, accbins} Equal @@ Through[{f1, f2, accbins}@rs] {0.019731, 0.00992831, 0.0619143}
True
