8
$\begingroup$

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.

$\endgroup$

7 Answers 7

6
$\begingroup$
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} *)
$\endgroup$
8
$\begingroup$

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:

enter image description here

$\endgroup$
7
$\begingroup$

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

$\endgroup$
1
  • 1
    $\begingroup$ Well, that's awesome. +1 $\endgroup$
    – ciao
    Commented Aug 27, 2020 at 18:16
6
$\begingroup$

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"}]

enter image description here

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}
$\endgroup$
3
$\begingroup$

Does this work for you?

{0,0,0,10,12,5,0,1,2,0} //.{h___,a_,b_,t___}/;a!=0&&b!=0:>{h,a+b,t}

which instantly returns

{0,0,0,27,0,3,0}

which Natas has politely pointed out is wrong because it didn't leave zeros.

This

{0,0,0,10,12,5,0,1,2,0} //.{h___,a_,b_,0,t___}/;a!=0&&b!=0:>{h,a+b,0,0,t}

returns

{0,0,0,27,0,0,0,3,0,0}

which is closer to what was asked for except when the last two or more values in the list are non-zero.

This

Most[Join[{0,0,0,10,12,5,0,1,2},{0}] //.{h___,a_,b_,0,t___}/;a!=0&&b!=0:>{h,a+b,0,0,t}]

will deal with the case where the last item in the list is non-zero and returns

{0,0,0,27,0,0,0,3,0}

but it isn't as simple.

$\endgroup$
2
  • 1
    $\begingroup$ This does not satisfy "then replace those values with zero, apart from the first value which should be the sum". $\endgroup$
    – Natas
    Commented Aug 26, 2020 at 16:29
  • $\begingroup$ @Natas You are right. Thank you. My mistake. And it looks like your comment has let him recognize that too. Let me see if I can fix that. $\endgroup$
    – Bill
    Commented Aug 26, 2020 at 16:39
2
$\begingroup$
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}

$\endgroup$
0
$\begingroup$

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.