This is a fun little problem, and I wanted to check with the experts here if there is a better functional/Mathematica way to approach solving it than what I did. I am not too happy with my solution since I use big IF THEN ELSE in it, but could not find a Mathematica command to use easily to do it (such as Select
, Cases
, Sow/Reap
, Map
.. etc...)
Here is the problem, given a list values (numbers or symbols), but for simplicity, lets assume a list of numbers for now. The list can contain zeros and the goal is replace the each zero with the element seen before it.
At the end, the list should contain no zeros in it.
Here is an example, given
a = {1, 0, 0, -1, 0, 0, 5, 0};
the result should be
a = {1, 1, 1, -1, -1, -1, 5, 5}
It should ofcourse be done in the most efficient way.
This is what I could come up with
Scan[(a[[#]] = If[a[[#]] == 0, a[[#-1]], a[[#]]]) &, Range[2, Length[a]]];
I wanted to see if I can use Sow/Reap on this, but did not know how.
question: can this be solved in a more functional/Mathematica way? The shorter the better ofcourse :)
update 1 Thanks everyone for the answer, all are very good to learn from. This is the result of speed test, on V 8.04, using windows 7, 4 GB Ram, intel 930 @2.8 Ghz:
I've tested the methods given for n
from 100,000
to 4 million
. The ReplaceRepeated
method does not do well for large lists.
update 2
Removed earlier result that was shown above in update1 due to my error in copying one of the tests.
The updated results are below. Leonid method is the fastest. Congratulation Leonid. A very fast method.
The test program is the following:
(*version 2.0 *)
runTests[sizeOfList_?(IntegerQ[#] && Positive[#] &)] :=
Module[{tests, lst, result, nasser, daniel, heike, leonid, andrei,
sjoerd, i, names},
nasser[lst_List] := Module[{a = lst},
Scan[(a[[#]] = If[a[[#]] == 0, a[[# - 1]], a[[#]]]) &,
Range[2, Length[a]]]
];
daniel[lst_List] := Module[{replaceWithPrior},
replaceWithPrior[ll_, n_: 0] :=
Module[{prev}, Map[If[# == 0, prev, prev = #] &, ll]
];
replaceWithPrior[lst]
];
heike[lst_List] := Flatten[Accumulate /@ Split[lst, (#2 == 0) &]];
andrei[lst_List] := Module[{x, y, z},
ReplaceRepeated[lst, {x___, y_, 0, z___} :> {x, y, y, z},
MaxIterations -> Infinity]
];
leonid[lst_List] :=
FoldList[If[#2 == 0, #1, #2] &, First@#, Rest@#] & @lst;
sjoerd[lst_List] :=
FixedPoint[(1 - Unitize[#]) RotateRight[#] + # &, lst];
lst = RandomChoice[Join[ConstantArray[0, 10], Range[-1, 5]],
sizeOfList];
tests = {nasser, daniel, heike, leonid, sjoerd};
names = {"Nasser","Daniel", "Heike", "Leonid", "Sjoerd"};
result = Table[0, {Length[tests]}, {2}];
Do[
result[[i, 1]] = names[[i]];
Block[{j, r = Table[0, {5}]},
Do[
r[[j]] = First@Timing[tests[[i]][lst]], {j, 1, 5}
];
result[[i, 2]] = Mean[r]
],
{i, 1, Length[tests]}
];
result
]
To run the tests for length 1000 the command is:
Grid[runTests[1000], Frame -> All]
Thanks everyone for the answers.
Much (order of magnitude) faster than other solutions still:
FoldList[If[#2 == 0, #1, #2] &, First@#, Rest@#] &
The speedup is due to Fold
autocompiling. Will not be so dramatic for non-packed arrays. Benchmarks:
In[594]:=
a=b=c=RandomChoice[Join[ConstantArray[0,10],Range[-1,5]],150000];
(b=Flatten[Accumulate/@Split[b,(#2==0)&]]);//Timing
Scan[(a[[#]]=If[a[[#]]==0,a[[#-1]],a[[#]]])&,Range[2,Length[a]]]//Timing
(c=FoldList[If[#2==0,#1,#2]&,First@#,Rest@#]&@c);//Timing
SameQ[a,b,c]
Out[595]= {0.187,Null}
Out[596]= {0.625,Null}
Out[597]= {0.016,Null}
Out[598]= True
This seems to be a factor 4 faster on my machine:
a = Flatten[Accumulate /@ Split[a, (#2 == 0) &]]
The timings I get are
a = b = RandomChoice[Join[ConstantArray[0, 10], Range[-1, 5]], 10000];
(b = Flatten[Accumulate /@ Split[b, (#2 == 0) &]]); // Timing
Scan[(a[[#]] = If[a[[#]] == 0, a[[# - 1]], a[[#]]]) &,
Range[2, Length[a]]] // Timing
SameQ[a, b]
(* {0.015815, Null} *)
(* {0.061929, Null} *)
(* True *)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With