Mathematica Asked on July 25, 2021
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} *)
Correct answer by Natas on July 25, 2021
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.
Answered by Bill on July 25, 2021
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:
Answered by ciao on July 25, 2021
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}
Answered by kglr on July 25, 2021
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
Answered by Carl Woll on July 25, 2021
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP